Copy Link
Add to Bookmark
Report
NULL mag Issue 09 23 Create .DAT files
the following source code is a complete program written with
freepascal. i made it to use it with NULL mag. and other projects i
have in mind.
what it does is simple. you create a text file, which is something
like a map and based on this "map" file, it creates a .DAT file that
includes all files mentioned in the "map" file. so in sort, it's a
resource file maker.
you have noticed that each issue of NULL comes with a NULL.DAT file.
inside it, are included all files that make the issue, like texts,
ansis, music (in some cases). you can include anything you want.
you can use it in your own projects, like DOOR games, in which you
want to include DATA files for it. the awesomeness of this program is
that it converts ANSI files to BIN files and at the same time, removes
any SAUCE data from, even if they hav been created in WINDOWS or LINUX
box. Other .DAT makers, include also the SAUCE data and expect only
CRLF endings, which is a problem if you make them with a LINUX app.
so whatever the line ending is, even in text files, the program can
guess it and make the conversion.
it's based on the idea from GUTTER's source code and it's using bits
of code from it and from the open source mystic 1.10 version.
just compile the code with freepascal, no other units are needed.
to use it you just give in the command line:
./datmaker <listfile> <dat-file>'
<listfile> is a text file that includes information about the files to
be included in the .DAT file. the form of this file is this:
filename;title;author;category;id;type
filename: is the complete or relative path to the file you want to
included
title :
author :
category: all three fields are just string fields that you can use in
your program. NULL uses these for the articles, but you can
use them as you like
id : is a unique string, for each file. it's a code that you use
to recognize a file.
type : this field can have one of these two values txt or bin. if
the file you are including is a text (.txt, .ans) file, use
the txt type. this way the program will convert it as
needed. but if the file is a generic binary file (ex. .mod,
.zip etc) use the bin type and the file will be included as
it is.
this is a small example of the build list for NULL mag.:
./menu/tutorial.ans;tutorial menu;null;null;mntut;txt
./articles/about.ans;about;xqtr;null;about;txt
./fonts/boxround.fnt;boxround;font;font;fontd;bin
./music/dark_trance.mod;dark_trance;dark_trance.mod;music;mus02;bin
///.///.///.///.///.///.///.///.///.///.///.///.///.///.///.///.///.///
program datmaker;
{$mode objFPC}
{$PACKRECORDS 1}
{$H-}
Uses
crt,
classes,
sysutils;
Const
mysMaxMsgLines = 5000;
verifystring = 'datmkv10byxqtr';
type
trec = record
verify : string[14];
title : string[30];
author : string[30];
category : string[30];
id : string[5];
ftype : string[3];
ptr : string[10];
size : string[10];
end;
t4barray = array[1..4] of byte;
type
RecSauceInfo = packed record
ID: array [1..5] of char; // "SAUCE"
Version: array [1..2] of byte;
Title: array [1..35] of char;
Author: array [1..20] of char;
Group: array [1..20] of char;
Date: array [1..8] of char; // YYMMDD
FileSIze : Uint32; DataFileType : UInt16;
TInfo1 : Uint16;
TInfo2 : Uint16;
TInfo3 : Uint16;
TInfo4 : Uint16;
Comments: Byte;
TFlags: Byte;
TInfoS: array [1..22] of char; // null terminated - FontName
end;
Type
RecMessageLine = Array[1..80] of Record
Ch : Char;
Attr : Byte;
End;
AnsiImage = Array[1..mysMaxMsgLines] of RecMessageLine;
// make this a pointer...
TMsgBaseAnsi = Class
GotAnsi : Boolean;
GotPipe : Boolean;
PipeCode : String[2];
Owner : Pointer;
Data : AnsiImage;
Code : String;
Lines : Word;
CurY : Word;
Escape : Byte;
SavedX : Byte;
SavedY : Byte;
CurX : Byte;
Attr : Byte;
Procedure SetFore (Color: Byte);
Procedure SetBack (Color: Byte);
Procedure ResetControlCode;
Function ParseNumber (Var Line: String) : Integer;
Function AddChar (Ch: Char) : Boolean;
Procedure MoveXY (X, Y: Word);
Procedure MoveUP;
Procedure MoveDOWN;
Procedure MoveLEFT;
Procedure MoveRIGHT;
Procedure MoveCursor;
Procedure CheckCode (Ch: Char);
Procedure ProcessChar (Ch: Char);
Constructor Create (O: Pointer; Msg: Boolean);
Destructor Destroy; Override;
Function ProcessBuf (Var Buf; BufLen: Word) : Boolean;
Procedure Clear;
Function GetLineText (Line: Word) : String;
Procedure SetLineColor (Attri, Line: Word);
Procedure RemoveLine (Line: Word);
End;
Function AnsiGotoXY (X, Y: Byte) : String;
Begin
If X = 0 Then X := WhereX;
If Y = 0 Then Y := WhereY;
Result := #27 + '[' + inttostr(Y) + ';' + inttostr(X) + 'H';
End;
Procedure AnsiBin (FName,outfile: String);
Var
Buf : Array[1..4096] of Char;
BufLen : LongInt;
TopLine : LongInt;
WinSize : LongInt;
Ansi : TMsgBaseAnsi;
AFile : File;
Ch : Char;
FN : String;
Str : String;
Done : Boolean = False;
Per : SmallInt;
ofile : file;
cnt :integer;
x : byte;
cr,lf:char;
Begin
FN := FName;
cr:=#13;
lf:=#10;
If Not FileExists(FN) Then Exit;
Ansi := TMsgBaseAnsi.Create(nil, False);
ansi.clear;
Assign (AFile, FN);
//ioReset (AFile, 1, fmReadWrite + fmDenyNone);
Reset (AFile, 1);
While Not Eof(AFile) Do Begin
BlockRead (AFile, Buf, SizeOf(Buf), BufLen);
If Ansi.ProcessBuf (Buf, BufLen) Then Break;
End;
Close (AFile);
assign(ofile,outfile);
rewrite(ofile,1);
for cnt:=1 to ansi.lines do begin
for x:=1 to 80 do begin
blockwrite(ofile,ansi.data[cnt][x].ch,1);
blockwrite(ofile,ansi.data[cnt][x].attr,1);
end;
//blockwrite(ofile,cr,1);
//blockwrite(ofile,lf,1);
end;
close(ofile);
Ansi.Free;
End;
Constructor TMsgBaseAnsi.Create (O: Pointer; Msg: Boolean);
Begin
Inherited Create;
Owner := O;
Clear;
End;
Destructor TMsgBaseAnsi.Destroy;
Begin
Inherited Destroy;
End;
Procedure TMsgBaseAnsi.Clear;
Begin
Lines := 1;
CurX := 1;
CurY := 1;
Attr := 7;
GotAnsi := False;
GotPipe := False;
PipeCode := '';
FillChar (Data, SizeOf(Data), 0);
ResetControlCode;
End;
Procedure TMsgBaseAnsi.ResetControlCode;
Begin
Escape := 0;
Code := '';
End;
Procedure TMsgBaseAnsi.SetFore (Color: Byte);
Begin
Attr := Color + ((Attr SHR 4) AND 7) * 16;
End;
Procedure TMsgBaseAnsi.SetBack (Color: Byte);
Begin
Attr := (Attr AND $F) + Color * 16;
End;
Function TMsgBaseAnsi.AddChar (Ch: Char) : Boolean;
Begin
AddChar := False;
Data[CurY][CurX].Ch := Ch;
Data[CurY][CurX].Attr := Attr;
If CurX < 80 Then
Inc (CurX)
Else Begin
If CurY = mysMaxMsgLines Then Begin
AddChar := True;
Exit;
End Else Begin
CurX := 1;
Inc (CurY);
End;
End;
End;
Function TMsgBaseAnsi.ParseNumber (Var Line: String) : Integer;
Var
A : Integer;
B : LongInt;
Str1 : String;
Str2 : String;
Begin
Str1 := Line;
Val(Str1, A, B);
If B = 0 Then
Str1 := ''
Else Begin
Str2 := Copy(Str1, 1, B - 1);
Delete (Str1, 1, B);
Val (Str2, A, B);
End;
Line := Str1;
ParseNumber := A;
End;
Procedure TMsgBaseAnsi.MoveXY (X, Y: Word);
Begin
If X > 80 Then X := 80;
If Y > mysMaxMsgLines Then Y := mysMaxMsgLines;
CurX := X;
CurY := Y;
End;
Procedure TMsgBaseAnsi.MoveCursor;
Var
X : Byte;
Y : Byte;
Begin
X := ParseNumber(Code);
Y := ParseNumber(Code);
If X = 0 Then X := 1;
If Y = 0 Then Y := 1;
MoveXY (X, Y);
ResetControlCode;
End;
Procedure TMsgBaseAnsi.MoveUP;
Var
NewPos : Integer;
Offset : Integer;
Begin
Offset := ParseNumber (Code);
If Offset = 0 Then Offset := 1;
If (CurY - Offset) < 1 Then
NewPos := 1
Else
NewPos := CurY - Offset;
MoveXY (CurX, NewPos);
ResetControlCode;
End;
Procedure TMsgBaseAnsi.MoveDOWN;
Var
NewPos : Byte;
Begin
NewPos := ParseNumber (Code);
If NewPos = 0 Then NewPos := 1;
MoveXY (CurX, CurY + NewPos);
ResetControlCode;
End;
Procedure TMsgBaseAnsi.MoveLEFT;
Var
NewPos : Integer;
Offset : Integer;
Begin
Offset := ParseNumber (Code);
If Offset = 0 Then Offset := 1;
If CurX - Offset < 1 Then
NewPos := 1
Else
NewPos := CurX - Offset;
MoveXY (NewPos, CurY);
ResetControlCode;
End;
Procedure TMsgBaseAnsi.MoveRIGHT;
Var
NewPos : Integer;
Offset : Integer;
Begin
Offset := ParseNumber(Code);
If Offset = 0 Then Offset := 1;
If CurX + Offset > 80 Then Begin
NewPos := (CurX + Offset) - 80;
Inc (CurY);
End Else
NewPos := CurX + Offset;
MoveXY (NewPos, CurY);
ResetControlCode;
End;
Procedure TMsgBaseAnsi.CheckCode (Ch: Char);
Var
Temp1 : Byte;
Temp2 : Byte;
Begin
Case Ch of
'0'..'9', ';', '?' : Code := Code + Ch;
'H', 'f' : MoveCursor;
'A' : MoveUP;
'B' : MoveDOWN;
'C' : MoveRIGHT;
'D' : MoveLEFT;
'J' : Begin
{ClearScreenData;}
ResetControlCode;
End;
'K' : Begin
Temp1 := CurX;
For Temp2 := CurX To 80 Do
AddChar(' ');
MoveXY (Temp1, CurY);
ResetControlCode;
End;
'h' : ResetControlCode;
'm' : Begin
While Length(Code) > 0 Do Begin
Case ParseNumber(Code) of
0 : Attr := 7;
1 : Attr := Attr OR $08;
5 : Attr := Attr OR $80;
7 : Begin
Attr := Attr AND $F7;
Attr := ((Attr AND $70) SHR 4) + ((Attr AND $7) SHL 4) + Attr AND $80;
End;
30: Attr := (Attr AND $F8) + 0;
31: Attr := (Attr AND $F8) + 4;
32: Attr := (Attr AND $F8) + 2;
33: Attr := (Attr AND $F8) + 6;
34: Attr := (Attr AND $F8) + 1;
35: Attr := (Attr AND $F8) + 5;
36: Attr := (Attr AND $F8) + 3;
37: Attr := (Attr AND $F8) + 7;
40: SetBack (0);
41: SetBack (4);
42: SetBack (2);
43: SetBack (6);
44: SetBack (1);
45: SetBack (5);
46: SetBack (3);
47: SetBack (7);
End;
End;
ResetControlCode;
End;
's' : Begin
SavedX := CurX;
SavedY := CurY;
ResetControlCode;
End;
'u' : Begin
MoveXY (SavedX, SavedY);
ResetControlCode;
End;
Else
ResetControlCode;
End;
End;
Procedure TMsgBaseAnsi.ProcessChar (Ch: Char);
Begin
If GotPipe Then Begin
PipeCode := PipeCode + Ch;
If Length(PipeCode) = 2 Then Begin
Case strtoint(PipeCode) of
00..
15 : SetFore(strtoint(PipeCode));
16..
23 : SetBack(strtoint(PipeCode) - 16);
Else
AddChar('|');
AddChar(PipeCode[1]);
AddChar(PipeCode[2]);
End;
GotPipe := False;
PipeCode := '';
End;
Exit;
End;
Case Escape of
0 : Begin
Case Ch of
#27 : Escape := 1;
#9 : MoveXY (CurX + 8, CurY);
#12 : {Edit.ClearScreenData};
Else
AddChar (Ch);
ResetControlCode;
End;
End;
1 : If Ch = '[' Then Begin
Escape := 2;
Code := '';
GotAnsi := True;
End Else
Escape := 0;
2 : CheckCode(Ch);
Else
ResetControlCode;
End;
End;
Function TMsgBaseAnsi.ProcessBuf (Var Buf; BufLen: Word) : Boolean;
Var
Count : Word;
Buffer : Array[1..4096] of Char Absolute Buf;
Begin
Result := False;
For Count := 1 to BufLen Do Begin
If CurY > Lines Then Lines := CurY;
Case Buffer[Count] of
#10 : If CurY = mysMaxMsgLines Then Begin
Result := True;
GotAnsi := False;
Break;
End Else Begin
CurY:=CurY+1;
CurX := 1;
End;
#13 : CurX := 1;
#26 : Begin
Result := True;
Break;
End;
Else
ProcessChar(Buffer[Count]);
End;
End;
End;
Function TMsgBaseAnsi.GetLineText (Line: Word) : String;
Var
Count : Word;
Begin
Result := '';
If Line > Lines Then Exit;
For Count := 1 to 80 Do
Result := Result + Data[Line][Count].Ch;
End;
Procedure TMsgBaseAnsi.SetLineColor (Attri, Line: Word);
Var
Count : Word;
Begin
For Count := 1 to 80 Do
Data[Line][Count].Attr := Attri;
End;
Procedure TMsgBaseAnsi.RemoveLine (Line: Word);
Var
Count : Word;
Begin
For Count := Line to Lines - 1 Do
Data[Count] := Data[Count + 1];
Dec (Lines);
End;
//======================================
var
records : array of trec;
tempfiles : array of string;
endheader : trec;
Function strWordGet (Num: Byte; Str: String; Ch: Char) : String;
Var
Count : Byte;
Temp : String;
Start : Byte;
Begin
strWordGet := '';
Count := 1;
Temp := Str;
If Pos(Ch,Str)<=0 Then Begin
Result:='';
Exit;
End;
If Ch = ' ' Then
While Temp[1] = Ch Do
Delete (Temp, 1, 1);
While Count < Num Do Begin
Start := Pos(Ch, Temp);
If Start = 0 Then Exit;
If Ch = ' ' Then Begin
While Temp[Start] = Ch Do
Inc (Start);
Dec(Start);
End;
Delete (Temp, 1, Start);
Inc (Count);
End;
If Pos(Ch, Temp) > 0 Then
strWordGet := Copy(Temp, 1, Pos(Ch, Temp) - 1)
Else
strWordGet := Temp;
End;
Function strPadR (Str: String; Len: Byte; Ch: Char) : String;
Begin
If Length(Str) > Len Then
Str := Copy(Str, 1, Len)
Else
While Length(Str) < Len Do Str := Str + Ch;
strPadR := Str;
End;
function getfilesize(f:string):longint;
var
fi:file of byte;
begin
assign(fi,f);
reset(fi);
result:=filesize(fi);
close(fi);
end;
Function ReadSauceInfo (F:string; Var Sauce: RecSauceInfo) : Boolean;
Var
Res : LongInt;
fi:tfilestream;
Begin
Result := False;
fi:= TFileStream.Create(f,fmOpenReadWrite or fmShareDenyNone);
fillbyte(sauce,sizeof(sauce),0);
try
fi.seek(-128,soFromEnd);
res:=fi.Read (Sauce, sizeof(sauce));
except
fi.free;
exit;
End;
fi.free;
Result := copy(sauce.id,1,5) = 'SAUCE';
End;
Function isSauce(S:RecSauceInfo):Boolean;
Begin
Result := copy(S.id,1,5) = 'SAUCE';
End;
function issauce(fin:string):boolean;
var
sauce : RecSauceInfo;
begin
result:=false;
if ReadSauceInfo(fin,sauce) then result:=true;
end;
function detectcr(f:string):boolean;
var
c:byte;
fi:tfilestream;
begin
result:=false;
fi:= TFileStream.Create(f,fmOpenReadWrite or fmShareDenyNone);
fi.Seek(0,0);
While (fi.position < fi.size) Do Begin
fi.read(c,1);
if c=13 then begin
result := true;
break;
end;
end;
fi.free;
end;
procedure loadlist(f:string);
var
sl : tstringlist;
i : integer;
s : string;
begin
if not fileexists(f) then begin
writeln('List file does not exist. Aborting...');
exit;
end;
sl := tstringlist.create;
sl.loadfromfile(f);
if sl.count = 0 then begin
writeln('No records found.');
sl.free;
exit;
end;
//remove notes
i:=sl.count-1;
while i>=0 do begin
s:=sl[i];
if s[1]='#' then sl.delete(i);
i:=i-1;
end;
setlength(records,sl.count);
setlength(tempfiles,sl.count);
for i:=0 to length(records)-1 do begin
tempfiles[i]:=strWordGet(1,sl[i],';');
records[i].title := strWordGet(2,sl[i],';');
records[i].author := strWordGet(3,sl[i],';');
records[i].category := strWordGet(4,sl[i],';');
records[i].id := strpadr(strWordGet(5,sl[i],';'),5,'_');
records[i].ftype := uppercase(strWordGet(6,sl[i],';'));
end;
sl.free;
end;
procedure convert2crlf(fin,fout:string);
var
c:byte;
fi:tfilestream;
fo:tfilestream;
begin
fi:= TFileStream.Create(fin,fmOpenReadWrite or fmShareDenyNone);
fo:= TFileStream.Create(fout,classes.fmCreate or fmShareDenyNone);
fi.Seek(0,0);
While (fi.position < fi.size) Do Begin
fi.read(c,1);
if c=10 then begin
c:=13;
fo.write(c,1);
c:=10;
fo.write(c,1);
end else fo.write(c,1);
end;
fi.free;
fo.free;
end;
procedure removesaucedata(fin,fout:string);
var
fi : tfilestream;
fo : tfilestream;
Sauce : RecSauceInfo;
fend : longint = 0;
b : byte;
begin
if ReadSauceInfo(fin,sauce)=false then exit;
fi:= TFileStream.Create(fin,fmOpenReadWrite or fmShareDenyNone);
fo:= TFileStream.Create(fout,classes.fmCreate or fmShareDenyNone);
if sauce.comments>0 then fend:=fi.size-128-(sauce.comments*64)-5
else fend:=fi.size-128;
fi.Seek(0,0);
while fi.position<fend do begin
fi.read(b,1);
fo.write(b,1);
end;
fo.free;
fi.free;
end;
procedure processfiles;
var i:integer;
begin
for i:=0 to length(records)-1 do begin
if fileexists(tempfiles[i]) then begin
if records[i].ftype = 'TXT' then begin
if detectcr(tempfiles[i])=false then begin
convert2crlf(tempfiles[i],tempfiles[i]+'.tmp');
tempfiles[i]:=tempfiles[i]+'.tmp';
end;
if issauce(tempfiles[i]) then begin
removesaucedata(tempfiles[i],tempfiles[i]+'.tmp');
if pos('.tmp',tempfiles[i])>0 then deletefile(tempfiles[i]);
tempfiles[i]:=tempfiles[i]+'.tmp';
end;
AnsiBin(tempfiles[i],tempfiles[i]+'.bin');
if pos('.tmp',tempfiles[i])>0 then deletefile(tempfiles[i]);
tempfiles[i]:=tempfiles[i]+'.bin';
end;
end;
end;
end;
procedure deletetempfiles;
var i:integer;
begin
for i:=0 to length(records)-1 do begin
if pos('.tmp',tempfiles[i])>0 then deletefile(tempfiles[i]);
if pos('.bin',tempfiles[i])>0 then deletefile(tempfiles[i]);
end;
end;
procedure createdatfile;
var
fi : file;
fo : file;
i : integer;
headersize : longint = 0;
p : longint = 0;
size : longint = 0;
b : byte;
begin
assign(fo,paramstr(2));
rewrite(fo,1);
//populate headers
headersize := length(records)*sizeof(trec);//+sizeof(endheader);
p:=headersize;
writeln(' [] Writing headers...'+inttostr(p));
for i:=0 to length(records)-1 do begin
records[i].verify := verifystring;
size:=getfilesize(tempfiles[i]);
records[i].size:=inttostr(size);
records[i].ptr:=inttostr(p);
blockwrite(fo,records[i],sizeof(trec));
p:=p+size;
end;
writeln(' [] Adding actual files...');
for i:=0 to length(records)-1 do begin
assign(fi,tempfiles[i]);
reset(fi,1);
while not eof(fi) do begin
blockread(fi,b,1);
blockwrite(fo,b,1);
end;
close(fi);
gotoxy(1,wherey);
write(' '+inttostr( (filesize(fo)*100) div p)+'% ');
end;
close(fo);
writeln;
end;
procedure init;
begin
with endheader do begin
title:='datmkv10byxqtr';
author:='tttttttttttttt';
category:='rrrrrrrrrrrrrr';
id:='datmk';
ftype:='bin';
end;
end;
var
a : char;
begin
if paramcount < 2 then begin
writeln;
writeln('DATMAKER v1.0 -----------------------------------------------------------------');
writeln('');
writeln('USAGE: ./datmaker <listfile> <dat-file>');
writeln;
writeln('<listfile> :');
writeln('The listfile is a csv-type file which holds information about the included');
writeln('files. Each line is for one file. The format of the listfile is below.');
writeln('');
writeln('Example Listfile:');
writeln('#filename;title;author;category;id;type');
writeln('article.txt;this is an example;you;various;art12;txt');
writeln('');
writeln('filename : Full filename for the file to be included');
writeln('title : A title for the file');
writeln('author : Who wrote the file');
writeln('category : Some type of tag');
writeln('id : A 5 character identification string ex: xxx12,asdfg etc.');
writeln('type : Enter txt if the file is of text type (.txt, .diz, .ans) or');
writeln(' bin if it''s a binary file (.png, .exe, .dat)');
writeln('');
writeln('<dat-file> : The name of the file to be created.');
writeln('-------------------------------------------------------------------------------');
writeln('');
exit;
end;
if fileexists(paramstr(2)) then begin
writeln('The destination file all ready exists. Overwrite? (Y/n):');
a:=readkey;
if (a='n') or (a='N') then begin
writeln('Aborted...');
exit;
end;
end;
clrscr;
init;
writeln('--- DAT Maker v1.0 ------------------------------------------ XQTR ---');
writeln(' [] Loading list...');
loadlist(paramstr(1));
writeln(' [] Converting text files...');
processfiles;
writeln(' [] Creating .DAT file...');
createdatfile;
writeln(' [] Clean up temp files...');
deletetempfiles;
writeln(' [] Done...');
setlength(records,0);
setlength(tempfiles,0);
writeln('---------------------------------------------------------------------');
writeln;
end.
///.///.///.///.///.///.///.///.///.///.///.///.///.///.///.///.///.///
