Index: /oup/releases/0.12a/OniUnPacker.bdsproj =================================================================== --- /oup/releases/0.12a/OniUnPacker.bdsproj (revision 21) +++ /oup/releases/0.12a/OniUnPacker.bdsproj (revision 21) @@ -0,0 +1,171 @@ + + + + + + + + + + + + OniUnPacker.dpr + + + 7.0 + + + 8 + 0 + 1 + 1 + 0 + 0 + 1 + 1 + 1 + 0 + 0 + 1 + 0 + 1 + 1 + 1 + 0 + 0 + 0 + 0 + 0 + 1 + 0 + 1 + 1 + 1 + True + True + WinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE; + + False + + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + False + False + False + True + True + True + + + 0 + 0 + 1 + False + False + False + 16384 + 1048576 + 4194304 + + + + + + + + + xmlrtl;rtl;vcl;vclie;inet;inetdbbde;inetdbxpress;vclx;IndySystem;IndyCore;dbrtl;dsnap;soaprtl;IndyProtocols;bdertl;vcldbx;vcldb;webdsnap;websnap;vclactnband;GridPackd2005;TWrapGrid;Package1;A406_R70;CoolTrayIcon_D6plus + + + False + + + + + + False + + + + + + False + + + False + False + 1 + 0 + 0 + 0 + False + False + False + False + False + 1031 + 1252 + + + + + 1.0.0.0 + + + + + + 1.0.0.0 + + + (untitled) + Borland Web Wizard Package + + + Index: /oup/releases/0.12a/OniUnPacker.cfg =================================================================== --- /oup/releases/0.12a/OniUnPacker.cfg (revision 21) +++ /oup/releases/0.12a/OniUnPacker.cfg (revision 21) @@ -0,0 +1,38 @@ +-$A8 +-$B- +-$C+ +-$D+ +-$E- +-$F- +-$G+ +-$H+ +-$I+ +-$J- +-$K- +-$L+ +-$M- +-$N+ +-$O+ +-$P+ +-$Q- +-$R- +-$S- +-$T- +-$U- +-$V+ +-$W- +-$X+ +-$YD +-$Z1 +-cg +-AWinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE; +-H+ +-W+ +-M +-$M16384,1048576 +-K$00400000 +-LE"C:\Dokumente und Einstellungen\Administrator\Eigene Dateien\Borland Studio Projects\Bpl" +-LN"C:\Dokumente und Einstellungen\Administrator\Eigene Dateien\Borland Studio Projects\Bpl" +-w-UNSAFE_TYPE +-w-UNSAFE_CODE +-w-UNSAFE_CAST Index: /oup/releases/0.12a/OniUnPacker.dpr =================================================================== --- /oup/releases/0.12a/OniUnPacker.dpr (revision 21) +++ /oup/releases/0.12a/OniUnPacker.dpr (revision 21) @@ -0,0 +1,19 @@ +PROGRAM OniUnPacker; +uses + Forms, + Unit1_main in 'Unit1_main.pas' {Form1}, + Unit2_functions in 'Unit2_functions.pas', + Unit3_data in 'Unit3_data.pas', + Unit4_Exporters in 'Unit4_Exporters.pas', + Unit5_preview in 'Unit5_preview.pas' {Form5}, + Unit6_imgfuncs in 'Unit6_imgfuncs.pas'; + +{$R *.res} + +BEGIN + Application.Initialize; + Application.Title:='Oni Un/Packer'; + Application.CreateForm(TForm1, Form1); + Application.CreateForm(TForm5, Form5); + Application.Run; +END. Index: /oup/releases/0.12a/Unit1_main.dfm =================================================================== --- /oup/releases/0.12a/Unit1_main.dfm (revision 21) +++ /oup/releases/0.12a/Unit1_main.dfm (revision 21) @@ -0,0 +1,301 @@ +object Form1: TForm1 + Left = 0 + Top = 0 + HorzScrollBar.Visible = False + VertScrollBar.Visible = False + AutoScroll = False + Caption = 'Form1' + ClientHeight = 454 + ClientWidth = 742 + Color = clBtnFace + Font.Charset = DEFAULT_CHARSET + Font.Color = clWindowText + Font.Height = -11 + Font.Name = 'Tahoma' + Font.Style = [] + Menu = menu + OldCreateOrder = False + OnClose = FormClose + OnCreate = FormCreate + OnResize = FormResize + PixelsPerInch = 96 + TextHeight = 13 + object panel_all: TPanel + Left = 0 + Top = 100 + Width = 692 + Height = 300 + BevelOuter = bvNone + TabOrder = 0 + object Splitter2: TSplitter + Left = 360 + Top = 0 + Width = 8 + Height = 300 + AutoSnap = False + Beveled = True + MinSize = 360 + OnMoved = Splitter2Moved + end + object panel_left: TPanel + Left = 0 + Top = 0 + Width = 360 + Height = 300 + Cursor = crDrag + Align = alLeft + BevelOuter = bvNone + TabOrder = 0 + object Splitter1: TSplitter + Left = 0 + Top = 241 + Width = 360 + Height = 8 + Cursor = crVSplit + Align = alTop + AutoSnap = False + Beveled = True + MinSize = 75 + OnMoved = Splitter1Moved + end + object panel_files: TPanel + Left = 0 + Top = 0 + Width = 360 + Height = 241 + Align = alTop + BevelOuter = bvNone + TabOrder = 0 + object btn_extractallconvert: TButton + Left = 273 + Top = 208 + Width = 82 + Height = 33 + Caption = 'Extract all (with convert)' + TabOrder = 0 + WordWrap = True + OnClick = btn_extractallconvertClick + end + object btn_extract: TButton + Left = 0 + Top = 208 + Width = 100 + Height = 33 + Caption = 'Extract file (without convert)' + TabOrder = 1 + WordWrap = True + OnClick = btn_extractconvertClick + end + object btn_extractconvert: TButton + Left = 101 + Top = 208 + Width = 105 + Height = 33 + Caption = 'Extract file (with convert if possible)' + TabOrder = 2 + WordWrap = True + OnClick = btn_extractconvertClick + end + object list_files: TListBox + Left = 0 + Top = 0 + Width = 360 + Height = 209 + Align = alTop + Font.Charset = DEFAULT_CHARSET + Font.Color = clWindowText + Font.Height = -11 + Font.Name = 'Fixedsys' + Font.Style = [] + ItemHeight = 15 + ParentFont = False + TabOrder = 3 + OnClick = list_filesDblClick + OnDblClick = list_filesDblClick + end + object btn_extractall: TButton + Left = 210 + Top = 208 + Width = 62 + Height = 33 + Caption = 'Extract all' + TabOrder = 4 + WordWrap = True + OnClick = btn_extractallconvertClick + end + end + object list_extensions: TListBox + Left = 0 + Top = 249 + Width = 360 + Height = 51 + Align = alClient + Font.Charset = DEFAULT_CHARSET + Font.Color = clWindowText + Font.Height = -11 + Font.Name = 'Fixedsys' + Font.Style = [] + ItemHeight = 15 + ParentFont = False + Sorted = True + TabOrder = 1 + OnClick = list_extensionsClick + OnDblClick = list_extensionsClick + end + end + object panel_right: TPanel + Left = 368 + Top = 0 + Width = 324 + Height = 300 + Align = alClient + BevelOuter = bvNone + TabOrder = 1 + object Splitter3: TSplitter + Left = 0 + Top = 200 + Width = 324 + Height = 8 + Cursor = crVSplit + Align = alTop + AutoSnap = False + Beveled = True + MinSize = 75 + end + object edit_data: TMemo + Left = 0 + Top = 0 + Width = 324 + Height = 200 + Align = alTop + Font.Charset = DEFAULT_CHARSET + Font.Color = clWindowText + Font.Height = -13 + Font.Name = 'Fixedsys' + Font.Style = [] + ParentFont = False + ReadOnly = True + ScrollBars = ssVertical + TabOrder = 0 + WordWrap = False + end + object list_names: TListBox + Left = 0 + Top = 208 + Width = 324 + Height = 92 + Align = alClient + Font.Charset = DEFAULT_CHARSET + Font.Color = clWindowText + Font.Height = -11 + Font.Name = 'Fixedsys' + Font.Style = [] + ItemHeight = 15 + ParentFont = False + Sorted = True + TabOrder = 1 + end + end + end + object panel_info: TPanel + Left = 0 + Top = 0 + Width = 742 + Height = 100 + Align = alTop + BevelOuter = bvNone + TabOrder = 1 + object lbl_info: TLabel + Left = 2 + Top = 26 + Width = 345 + Height = 73 + AutoSize = False + end + object lbl_fileinfo: TLabel + Left = 380 + Top = 0 + Width = 345 + Height = 99 + AutoSize = False + end + object btn_load: TButton + Left = 0 + Top = 0 + Width = 81 + Height = 25 + Caption = 'Load dat-file' + TabOrder = 0 + OnClick = btn_loadClick + end + object btn_hexcopy: TButton + Left = 295 + Top = 64 + Width = 89 + Height = 33 + Caption = 'Copy filedata as hex to clipboard' + TabOrder = 1 + WordWrap = True + OnClick = btn_hexcopyClick + end + end + object group_progress: TGroupBox + Left = 160 + Top = 384 + Width = 297 + Height = 57 + Caption = 'Extracting...' + TabOrder = 2 + Visible = False + object lbl_progress: TLabel + Left = 10 + Top = 36 + Width = 279 + Height = 18 + AutoSize = False + end + object progress: TProgressBar + Left = 8 + Top = 16 + Width = 217 + Height = 17 + Step = 1 + TabOrder = 0 + end + object btn_extractcancel: TButton + Left = 232 + Top = 16 + Width = 57 + Height = 33 + Caption = 'Cancel' + TabOrder = 1 + OnClick = btn_extractcancelClick + end + end + object fopen: TOpenDialog + Filter = 'Oni-Dat-Files|*.dat|Oni-Sep-Files (MAC)|*.sep' + Left = 72 + end + object menu: TMainMenu + AutoHotkeys = maManual + Left = 128 + object menu_main: TMenuItem + Caption = 'Main' + object menu_exit: TMenuItem + Caption = 'Exit' + OnClick = menu_exitClick + end + end + object menu_tools: TMenuItem + Caption = 'Tools' + object menu_txmpreplace: TMenuItem + Caption = 'TXMP replacer' + OnClick = menu_txmpreplaceClick + end + end + object menu_preview: TMenuItem + Caption = 'Preview Window' + OnClick = menu_previewClick + end + end +end Index: /oup/releases/0.12a/Unit1_main.pas =================================================================== --- /oup/releases/0.12a/Unit1_main.pas (revision 21) +++ /oup/releases/0.12a/Unit1_main.pas (revision 21) @@ -0,0 +1,383 @@ +UNIT Unit1_main; +INTERFACE +USES + Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, + Dialogs, StdCtrls, StrUtils, Clipbrd, ExtCtrls, ComCtrls, Menus, + Unit2_functions, Unit3_data, Unit5_preview, Unit7_txmpreplace; + +TYPE + TForm1 = Class(TForm) + panel_all: TPanel; + panel_left: TPanel; + Splitter1: TSplitter; + panel_files: TPanel; + btn_extractallconvert: TButton; + btn_extract: TButton; + btn_extractconvert: TButton; + list_files: TListBox; + btn_extractall: TButton; + list_extensions: TListBox; + Splitter2: TSplitter; + panel_right: TPanel; + edit_data: TMemo; + list_names: TListBox; + Splitter3: TSplitter; + panel_info: TPanel; + lbl_info: TLabel; + btn_load: TButton; + btn_hexcopy: TButton; + fopen: TOpenDialog; + lbl_fileinfo: TLabel; + group_progress: TGroupBox; + progress: TProgressBar; + lbl_progress: TLabel; + menu: TMainMenu; + menu_main: TMenuItem; + menu_exit: TMenuItem; + menu_preview: TMenuItem; + btn_extractcancel: TButton; + menu_tools: TMenuItem; + menu_txmpreplace: TMenuItem; + procedure menu_txmpreplaceClick(Sender: TObject); + procedure menu_exitClick(Sender: TObject); + procedure btn_extractcancelClick(Sender: TObject); + PROCEDURE menu_previewClick(Sender: TObject); + PROCEDURE btn_extractallconvertClick(Sender: TObject); + PROCEDURE Splitter2Moved(Sender: TObject); + PROCEDURE Splitter1Moved(Sender: TObject); + PROCEDURE FormClose(Sender: TObject; var Action: TCloseAction); + PROCEDURE btn_hexcopyClick(Sender: TObject); + PROCEDURE list_extensionsClick(Sender: TObject); + PROCEDURE FormResize(Sender: TObject); + PROCEDURE btn_extractconvertClick(Sender: TObject); + PROCEDURE FormCreate(Sender: TObject); + PROCEDURE list_filesDblClick(Sender: TObject); + PROCEDURE btn_loadClick(Sender: TObject); + PRIVATE + PUBLIC + END; + +VAR + Form1: TForm1; + +IMPLEMENTATION +{$R *.dfm} + +PROCEDURE DoAfterLoadOfADat; + VAR + i:LongWord; + txt:Text; + temp4:LongWord; + temp2:Word; + temp1:Byte; + BEGIN + IF NOT DirectoryExists(GetExtractPath) THEN + CreateDir(GetExtractPath); + AssignFile(txt,GetExtractPath+'\___TXMP-FILES___.TXT'); + ReWrite(txt); + FOR i:=0 TO dat_header.Extensions-1 DO BEGIN + IF (dat_extensionsmap[i].Extension[3]='T') AND + (dat_extensionsmap[i].Extension[2]='X') AND + (dat_extensionsmap[i].Extension[1]='M') AND + (dat_extensionsmap[i].Extension[0]='P') THEN BEGIN + WriteLn(txt, FormatNumber(dat_extensionsmap[i].ExtCount,4,'0')+' TXMP-Files'); + Break; + END; + END; + WriteLn(txt,'FileName'+#9+'MipMap'+#9+'Depth'+#9+'ImgX'+#9+'ImgY'+#9+'StoreT'); + FOR i:=0 TO dat_header.Files-1 DO BEGIN + IF dat_files[i].Extension='TXMP' THEN BEGIN + Write(txt,dat_files[i].FileName+#9); + LoadDatFilePart(i,$88,1,@temp1); + Write(txt,IntToHex(temp1,2)+#9); + LoadDatFilePart(i,$89,1,@temp1); + Write(txt,IntToHex(temp1,2)+#9); + LoadDatFilePart(i,$8C,2,@temp2); + Write(txt,IntToHex(temp2,4)+#9); + LoadDatFilePart(i,$8E,2,@temp2); + Write(txt,IntToHex(temp2,4)+#9); + LoadDatFilePart(i,$90,1,@temp1); + Write(txt,IntToHex(temp1,2)+#9); + WriteLn(txt,''); + END; + END; + CloseFile(txt); + + IF NOT DirectoryExists(GetExtractPath) THEN + CreateDir(GetExtractPath); + AssignFile(txt,GetExtractPath+'\___TXAN-FILES___.TXT'); + ReWrite(txt); + FOR i:=0 TO dat_header.Extensions-1 DO BEGIN + IF (dat_extensionsmap[i].Extension[3]='T') AND + (dat_extensionsmap[i].Extension[2]='X') AND + (dat_extensionsmap[i].Extension[1]='A') AND + (dat_extensionsmap[i].Extension[0]='N') THEN BEGIN + WriteLn(txt, FormatNumber(dat_extensionsmap[i].ExtCount,4,'0')+' TXAN-Files'); + Break; + END; + END; + WriteLn(txt,'FileName'+#9+'Loopspeed'+#9+'Unknown'+#9+'Links'); + FOR i:=0 TO dat_header.Files-1 DO BEGIN + IF dat_files[i].Extension='TXAN' THEN BEGIN + Write(txt,dat_files[i].FileName+#9); + LoadDatFilePart(i,$14,2,@temp2); + Write(txt,IntToHex(temp2,4)+#9); + LoadDatFilePart(i,$16,2,@temp2); + Write(txt,IntToHex(temp2,4)+#9); + LoadDatFilePart(i,$1C,4,@temp4); + Write(txt,IntToHex(temp4,8)+#9); + WriteLn(txt,''); + END; + END; + CloseFile(txt); + END; + +PROCEDURE TForm1.btn_loadClick(Sender: TObject); + VAR i:LongWord; + BEGIN + fopen.InitialDir:=AppSettings.DatPath; + IF fopen.Execute THEN BEGIN + Form1.Caption:='Oni Un/Packer '+version+' ('+ExtractFileName(fopen.FileName)+')'; + AppSettings.DatPath:=ExtractFilepath(fopen.FileName); + list_files.Items.Clear; + list_extensions.Items.Clear; + list_names.Items.Clear; + IF LoadDatInfos(fopen.FileName) THEN BEGIN + lbl_info.Caption:= + '# of files: '+IntToStr(dat_header.Files)+CrLf+ + '# of named files: '+IntToStr(dat_header.NamedFiles)+CrLf+ + '# of extensions: '+IntToStr(dat_header.Extensions)+CrLf+ + 'Address of Body: 0x'+IntToHex(dat_header.DataAddr,8)+CrLf+ + 'Address of End: 0x'+IntToHex(dat_header.NamesAddr,8); + list_extensions.Items.Add('_All files: '+FormatNumber(dat_header.Files,4,' ')); + FOR i:=0 TO dat_header.Extensions-1 DO BEGIN + WITH dat_extensionsmap[i] DO BEGIN + list_extensions.Items.Add( + Extension[3]+Extension[2]+Extension[1]+Extension[0]+': '+ + FormatNumber(ExtCount,4,' '));{+' (Ident: 0x'+ + IntToHex(Ident[7],2)+IntToHex(Ident[6],2)+IntToHex(Ident[5],2)+IntToHex(Ident[4],2)+IntToHex(Ident[3],2)+IntToHex(Ident[2],2)+IntToHex(Ident[1],2)+IntToHex(Ident[0],2)+')');} + END; + END; + FOR i:=0 TO dat_header.namedFiles-1 DO BEGIN + WITH dat_namedfilesmap[i] DO BEGIN + list_names.Items.Add('0x'+IntToHex(filenumber,8)+': 0x'+IntToHex(blubb,8)); + END; + END; + Form1.list_extensions.ItemIndex:=0; + Form1.list_extensionsClick(Form1); + Form1.list_files.ItemIndex:=0; + Form1.list_filesDblClick(Form1); + + Form7.RecreateTXMPlist; + + DoAfterLoadOfADat; + + END ELSE BEGIN + ShowMessage('Error while loading the file:'+CrLf+fopen.FileName+CrLf+'Perhaps not an Oni-.dat-file?'); + END; + END; + END; + +PROCEDURE TForm1.list_filesDblClick(Sender: TObject); + VAR + id:LongWord; + temp:Tdata; + BEGIN + id:=StrToInt(MidStr(list_files.Items.Strings[list_files.ItemIndex],1,5)); + lbl_fileinfo.Caption:= + 'Filename: '+dat_files[id].FileName+CrLf+ + 'Size: '+FormatFileSize(dat_files[id].Size)+' ('+IntToStr(dat_files[id].Size)+' Bytes)'+CrLf+ + 'FileType: 0x'+IntToHex(dat_files[id].FileType,8)+CrLf+ + 'Address in .dat: 0x'+IntTohex(dat_files[id].DatAddr,8); + IF (dat_files[id].FileType AND $02)=0 THEN BEGIN + temp:=LoadDatFile(id); + edit_data.Text:=CreateHexString(temp,False); + btn_hexcopy.Visible:=True; + IF menu_preview.Checked THEN Form5.ShowPreview(id); + END ELSE BEGIN + edit_data.Text:='Zero byte file.'+CrLf+'Oni will take the data for this file of level0_final.dat/raw'; + btn_hexcopy.Visible:=False; + END; + END; + +PROCEDURE TForm1.FormCreate(Sender: TObject); + BEGIN + Form1.Caption:='Oni Un/Packer '+version; + Form1.FormResize(Form1); + + panel_all.Align:=alClient; + + IF FileExists(ExtractFilepath(Application.EXEname)+'\oniunpacker.ini') THEN BEGIN + AssignFile(AppSettingsFile,ExtractFilepath(Application.EXEname)+'\oniunpacker.ini'); + Reset(AppSettingsFile); + Read(AppSettingsFile,AppSettings); + CloseFile(AppSettingsFile); + END ELSE BEGIN + AppSettings.DatPath:='D:\Spiele\Oni\GameDataFolder'; + AppSettings.ExtractPath:='C:\Dokumente und Einstellungen\Administrator\Desktop'; + END; + + //Form1.btn_loadClick(Form1); + END; + +PROCEDURE TForm1.btn_extractconvertClick(Sender: TObject); + VAR + result:Integer; + id:LongWord; + BEGIN + id:=StrToInt(MidStr(list_files.Items.Strings[list_files.ItemIndex],1,5)); + IF TComponent(Sender).Name='btn_extract' THEN + result:=ExportFile(id,False) + ELSE + result:=ExportFile(id,True); + CASE result OF + 0{export_noerror}: IF 1=2 THEN BEGIN END; + 1{export_nohandler}: ShowMessage('No export-handler for files with extension '+dat_files[id].Extension+'.'); + 2{export_handlererror}: ShowMessage('Error while running data-handler for '+CrLf+dat_files[id].FileName); + 3{export_error}: ShowMessage('Error while exporting file '+CrLf+dat_files[id].FileName); + ELSE ShowMessage('Couldn''t export file '+FormatNumber(id,5,'0')+CrLf+'(Unknown error)'); + END; + Form1.list_files.SetFocus; + END; + +PROCEDURE TForm1.FormResize(Sender: TObject); + CONST + MinWidth:Integer=750; + MinHeight:Integer=500; + BEGIN + IF NOT group_progress.Visible THEN BEGIN + IF Form1.Width0 THEN Inc(errors); + IF (i MOD 25)=0 THEN BEGIN + lbl_progress.Caption:=IntToStr(i)+'/'+IntToStr(dat_header.Files); + progress.Position:=i; + Application.ProcessMessages; + IF btn_extractcancel.Caption='Cancel_' THEN BEGIN + btn_extractcancel.Caption:='Cancel'; + Break; + END; + END; + END; + IF errors>0 THEN + ShowMessage(IntToStr(errors)+' errors encountered.'); + + Form1.Width:=oldwidth; + Form1.Height:=oldheight; + Form1.WindowState:=oldstate; + //FOR i:=0 TO menu.ComponentCount DO menu.Items.Items[i].Enabled:=True; + panel_all.Visible:=True; + panel_info.Visible:=True; + group_progress.Visible:=False; + END; + +PROCEDURE TForm1.menu_previewClick(Sender: TObject); + BEGIN + Form5.Visible:=NOT Form5.Visible; + END; + +PROCEDURE TForm1.btn_extractcancelClick(Sender: TObject); + BEGIN + btn_extractcancel.Caption:='Cancel_'; + END; + +PROCEDURE TForm1.menu_exitClick(Sender: TObject); + BEGIN + Form1.Close; + END; + +PROCEDURE TForm1.menu_txmpreplaceClick(Sender: TObject); + BEGIN + Form7.Visible:=NOT Form7.Visible; + END; + +END. Index: /oup/releases/0.12a/Unit2_functions.pas =================================================================== --- /oup/releases/0.12a/Unit2_functions.pas (revision 21) +++ /oup/releases/0.12a/Unit2_functions.pas (revision 21) @@ -0,0 +1,206 @@ +UNIT Unit2_functions; +INTERFACE +USES Classes, SysUtils, StrUtils, Math, Unit3_data, Unit4_Exporters; + +FUNCTION LoadDatInfos(filename:String):Boolean; +FUNCTION LoadDatFile(fileid:LongWord):Tdata; +FUNCTION LoadDatFilePart(fileid,offset,size:LongWord; target:Pointer):Boolean; +FUNCTION LoadRawFilePart(address,size:LongWord; target:Pointer):Boolean; +FUNCTION FormatNumber(value:LongWord; width:Byte; leadingzeros:Char):String; +FUNCTION FormatFileSize(size:LongWord):String; +FUNCTION CreateHexString(data:Tdata; HexOnly:Boolean):String; +FUNCTION ExportFile(fileid:LongWord; convert:Boolean):Integer; +FUNCTION GetWinFileName(fileid:LongWord; substring:String):String; +FUNCTION GetExtractPath:String; + + + +IMPLEMENTATION + + +FUNCTION LoadDatInfos(filename:String):Boolean; + VAR i:LongWord; + dat_file:TFileStream; + BEGIN + Result:=True; + IF Length(filename)>0 THEN dat_file.Free; + dat_filename:=filename; + raw_filename:=MidStr(filename,1,Length(filename)-3)+'raw'; + dat_file:=TFileStream.Create(filename, fmOpenRead); + dat_file.Read(dat_header,SizeOf(dat_header)); + FOR i:=0 TO High(dat_header.Ident) DO + IF dat_header.Ident[i]<>header_ident1[i] THEN BEGIN + Result:=False; + Exit; + END; +{ FOR i:=0 TO High(dat_header.Ident2) DO + IF dat_header.Ident2[i]<>header_ident2[i] THEN BEGIN + Result:=False; + Exit; + END; +} + SetLength(dat_filesmap,dat_header.Files); + SetLength(dat_files,dat_header.Files); + FOR i:=0 TO dat_header.Files-1 DO dat_file.Read(dat_filesmap[i],SizeOf(dat_filesmap[i])); + FOR i:=0 TO dat_header.Files-1 DO BEGIN + dat_files[i].Extension:=dat_filesmap[i].Extension; + dat_files[i].Extension:=ReverseString(dat_files[i].Extension); + dat_files[i].Size:=dat_filesmap[i].FileSize; + dat_files[i].FileType:=dat_filesmap[i].FileType; + dat_files[i].DatAddr:=dat_filesmap[i].DataAddr-8+dat_header.DataAddr; + IF (dat_filesmap[i].FileType AND $01)=0 THEN BEGIN + dat_file.Seek(dat_filesmap[i].NameAddr+dat_header.NamesAddr,soFromBeginning); + SetLength(dat_files[i].Name,100); + dat_file.Read(dat_files[i].Name[1],100); + dat_files[i].Name:=MidStr(dat_files[i].Name,1+4,Pos(#0,dat_files[i].Name)-1-4); + END ELSE BEGIN + dat_files[i].Name:=''; + END; + dat_files[i].FileName:=FormatNumber(i,5,'0')+'-'+dat_files[i].Name+'.'+dat_files[i].Extension; + END; + dat_file.Seek($40+dat_header.Files*$14,soFromBeginning); + SetLength(dat_namedfilesmap,dat_header.NamedFiles); + FOR i:=0 TO dat_header.NamedFiles-1 DO dat_file.Read(dat_namedfilesmap[i],SizeOf(dat_namedfilesmap[i])); + + dat_file.Seek($40+dat_header.Files*$14+dat_header.NamedFiles*$8,soFromBeginning); + SetLength(dat_extensionsmap,dat_header.Extensions); + FOR i:=0 TO dat_header.Extensions-1 DO dat_file.Read(dat_extensionsmap[i],SizeOf(dat_extensionsmap[i])); + + dat_file.Free; + END; + + +FUNCTION LoadDatFile(fileid:LongWord):Tdata; + VAR dat_file:TFileStream; + BEGIN + dat_file:=TFileStream.Create(dat_filename, fmOpenRead); + dat_file.Seek(dat_files[fileid].DatAddr,soFromBeginning); + SetLength(Result,dat_files[fileid].Size); + dat_file.Read(Result[0],dat_files[fileid].Size); + dat_file.Free; + END; + + +FUNCTION LoadDatFilePart(fileid,offset,size:LongWord; target:Pointer):Boolean; + VAR dat_file:TFileStream; + BEGIN + dat_file:=TFileStream.Create(dat_filename, fmOpenRead); + Result:=True; + dat_file.Seek(dat_files[fileid].DatAddr+offset,soFromBeginning); + dat_file.Read(target^,size); + dat_file.Free; + END; + + +FUNCTION LoadRawFilePart(address,size:LongWord; target:Pointer):Boolean; + VAR + filestream:TFileStream; + BEGIN + Result:=True; + filestream:=TFileStream.Create(AnsiReplaceStr(dat_filename,'.dat','.raw'),fmOpenRead); + filestream.Seek(address,soFromBeginning); + filestream.Read(target^,size); + filestream.Free; + END; + + +FUNCTION FormatNumber(value:LongWord; width:Byte; leadingzeros:Char):String; + BEGIN + Result:=AnsiReplaceStr(Format('%'+IntToStr(width)+'u',[value]),' ',leadingzeros); + END; + + +FUNCTION FormatFileSize(size:LongWord):String; + BEGIN + IF size>=1024*1024*1024 THEN BEGIN + Result:=FloatToStrF(size/1024/1024/1024,ffFixed,5,1)+' GB'; + END ELSE BEGIN + IF size>=1024*1024 THEN BEGIN + Result:=FloatToStrF(size/1024/1024,ffFixed,5,1)+' MB'; + END ELSE BEGIN + IF size>=1024 THEN BEGIN + Result:=FloatToStrF(size/1024,ffFixed,5,1)+' KB'; + END ELSE BEGIN + Result:=IntToStr(size)+' B'; + END; + END; + END; + END; + + +FUNCTION CreateHexString(data:Tdata; HexOnly:Boolean):String; + VAR + string_build,ascii_version:String; + i:LongWord; + BEGIN + string_build:=''; + ascii_version:=''; + FOR i:=0 TO High(data) DO BEGIN + IF NOT HexOnly THEN + IF (i MOD 16)=0 THEN + string_build:=string_build+'0x'+IntToHex(i,6)+' '; + string_build:=string_build+IntToHex(data[i],2); + IF NOT HexOnly THEN BEGIN + IF data[i]>=32 THEN ascii_version:=ascii_version+Chr(data[i]) + ELSE ascii_version:=ascii_version+'.'; + IF ((i+1) MOD 2)=0 THEN string_build:=string_build+#32; + IF ((i+1) MOD 16)=0 THEN BEGIN + string_build:=string_build+#32+ascii_version+CrLf; + ascii_version:=''; + END; + END; + END; + Result:=string_build; + END; + + +FUNCTION ExportFile(fileid:LongWord; convert:Boolean):Integer; + VAR + i:Byte; + BEGIN + Result:=export_noerror; + + ExportDefFileHeader(fileid); + + IF (dat_files[fileid].FileType AND $02)=0 THEN BEGIN + ExportDatFile(fileid); + + FOR i:=1 TO Length(ExportHandlers)+1 DO BEGIN + IF i<=Length(ExportHandlers) THEN BEGIN + IF ExportHandlers[i].Ext=dat_files[fileid].Extension THEN BEGIN + IF ExportHandlers[i].needed THEN BEGIN + CASE ExportHandlers[i].Handler(fileid,convert) OF + 0: Result:=0; + ELSE + Result:=export_handlererror; + END; + END; + Break; + END; + END ELSE BEGIN + Result:=export_nohandler; + END; + END; + END; + END; + + +FUNCTION GetWinFileName(fileid:LongWord; substring:String):String; + VAR + name:String; + BEGIN + name:=dat_files[fileid].Name; + name:=AnsiReplaceStr(name,'\','__'); + name:=AnsiReplaceStr(name,'/','__'); + name:=AnsiReplaceStr(name,'>','__'); + name:=AnsiReplaceStr(name,'<','__'); + Result:=FormatNumber(fileid,5,'0')+'-'+name+'.'+substring+'.'+dat_files[fileid].Extension; + END; + +FUNCTION GetExtractPath:String; + BEGIN + Result:=ExtractFilePath(dat_filename)+'\extracted_'+ExtractFileName(dat_filename); + END; + + +END. Index: /oup/releases/0.12a/Unit3_data.pas =================================================================== --- /oup/releases/0.12a/Unit3_data.pas (revision 21) +++ /oup/releases/0.12a/Unit3_data.pas (revision 21) @@ -0,0 +1,84 @@ +UNIT Unit3_data; +INTERFACE +USES Classes; + +CONST + version:String='v0.12a'; + CrLf:String[2]=#13+#10; + +TYPE + Tdata=Array OF Byte; + Theader=PACKED RECORD + Ident:Array[0..$13] OF Byte; + Files:LongWord; + NamedFiles:LongWord; + Extensions:LongWord; + DataAddr:LongWord; + DataSize:LongWord; + NamesAddr:LongWord; + NamesSize:LongWord; + Ident2:Array[0..$F] OF Byte; + END; + Tfilesmap=Array OF PACKED RECORD + Extension:Array[0..$3] OF Char; + DataAddr:LongWord; + NameAddr:LongWord; + FileSize:LongWord; + FileType:LongWord; + END; + Tfiles=Array OF PACKED RECORD + FileName:String; + Extension:String[4]; + Name:String; + Size:LongWord; + FileType:LongWord; + DatAddr:LongWord; + END; + + Tnamedfilesmap=Array OF PACKED RECORD + FileNumber:LongWord; + blubb:LongWord; + END; + Textensionsmap=Array OF PACKED RECORD + Ident:Array[0..$7] OF Byte; + Extension:Array[0..$3] OF Char; + ExtCount:LongWord; + END; + + TAppSettings=RECORD + DatPath:String[250]; + ExtractPath:String[250]; + END; + + TExportHandlers=RECORD + Ext:String[4]; + needed:Boolean; + Handler:Function(fileid:LongWord; convert:Boolean):Integer; + END; + +VAR + dat_filename:String=''; + raw_filename:String=''; + dat_header:Theader; + dat_filesmap:Tfilesmap; + dat_files:Tfiles; + dat_namedfilesmap:Tnamedfilesmap; + dat_extensionsmap:Textensionsmap; + AppSettings:TAppSettings; + AppSettingsFile:File OF TAppSettings; + +CONST + header_ident1:Array[0..$13] OF Byte= + ($1F,$27,$DC,$33,$DF,$BC,$03,$00,$31,$33,$52,$56,$40,$00,$14,$00,$10,$00,$08,$00); + header_ident2:Array[0..$F] OF Byte= + ($99,$CF,$40,$00,$90,$4F,$63,$00,$F4,$55,$5F,$00,$90,$4F,$63,$00); + + export_noerror:Integer=0; + export_nohandler:Integer=1; + export_handlererror:Integer=2; + export_error:Integer=3; + +IMPLEMENTATION + +END. + Index: /oup/releases/0.12a/Unit4_Exporters.pas =================================================================== --- /oup/releases/0.12a/Unit4_Exporters.pas (revision 21) +++ /oup/releases/0.12a/Unit4_Exporters.pas (revision 21) @@ -0,0 +1,180 @@ +UNIT Unit4_Exporters; +INTERFACE +USES Classes, StrUtils, SysUtils, Math, Unit3_data, Unit6_imgfuncs; + +PROCEDURE ExportDefLine(fileid:LongWord; line:String; create:Boolean); +PROCEDURE ExportDefFileHeader(fileid:LongWord); +PROCEDURE ExportDatFile(fileid:LongWord); + +FUNCTION ExportTRAC(fileid:LongWord; convert:Boolean):Integer; +FUNCTION ExportTXAN(fileid:LongWord; convert:Boolean):Integer; +FUNCTION ExportTXMB(fileid:LongWord; convert:Boolean):Integer; +FUNCTION ExportTXMP(fileid:LongWord; convert:Boolean):Integer; +VAR + ExportHandlers:Array[1..5] OF TExportHandlers=( + (Ext:'ABNA'; needed:False), + //(Ext:'AGDB'; needed:False), + (Ext:'TRAC'; needed:True; Handler:ExportTRAC), + (Ext:'TXAN'; needed:True; Handler:ExportTXAN), + (Ext:'TXMB'; needed:True; Handler:ExportTXMB), + (Ext:'TXMP'; needed:True; Handler:ExportTXMP) + ); + + + +IMPLEMENTATION +USES Unit2_functions; + +PROCEDURE ExportDefLine(fileid:LongWord; line:String; create:Boolean); + VAR + filestream:TFileStream; + data:Tdata; + i:LongWord; + BEGIN + SetLength(data,Length(line)+2); + FOR i:=1 TO Length(line) DO + data[i-1]:=Ord(line[i]); + data[Length(line)]:=13; + data[Length(line)+1]:=10; + + IF create THEN + filestream:=TFileStream.Create(GetExtractPath+'\'+GetWinFileName(fileid,'_DEF_'),fmCreate) + ELSE BEGIN + filestream:=TFileStream.Create(GetExtractPath+'\'+GetWinFileName(fileid,'_DEF_'),fmOpenWrite); + filestream.Seek(0,soFromEnd); + END; + filestream.Write(data[0],Length(data)); + filestream.Free; + END; + +PROCEDURE ExportDefFileHeader(fileid:LongWord); + BEGIN + IF NOT DirectoryExists(GetExtractPath) THEN + CreateDir(GetExtractPath); + WITH dat_files[fileid] DO + ExportDefLine(fileid,FormatNumber(fileid,5,'0')+':'+Name+':'+Extension+':'+IntToHex(Size,8)+':'+IntToHex(FileType,8),True); + END; + +PROCEDURE ExportDatFile(fileid:LongWord); + VAR + filestream:TFileStream; + data:Tdata; + BEGIN + data:=LoadDatFile(fileid); + filestream:=TFileStream.Create(GetExtractPath+'\'+GetWinFileName(fileid,'_DAT_'),fmCreate); + filestream.Write(data[0],Length(data)); + filestream.Free; + END; + + +FUNCTION ExportTRAC; + VAR + link:LongWord; + linkcount:Word; + i:LongWord; + BEGIN + Result:=export_noerror; + + LoadDatFilePart(fileid,$18,SizeOf(link),@link); + link:=link DIV 256; + ExportDefLine(fileid,FormatNumber(0,4,'0')+':LINKtoTRAC:'+FormatNumber(link,5,'0')+':'+dat_files[link].Name+':'+dat_files[link].Extension,False); + + LoadDatFilePart(fileid,$1E,SizeOf(linkcount),@linkcount); + ExportDefLine(fileid,'TRAMLINKS:'+FormatNumber(linkcount,4,'0'),False); + FOR i:=1 TO linkcount DO BEGIN + LoadDatFilePart(fileid,$20+(i-1)*12+8,SizeOf(link),@link); + link:=link DIV 256; + ExportDefLine(fileid,FormatNumber(i,4,'0')+':LINKtoTRAM:'+FormatNumber(link,5,'0')+':'+dat_files[link].Name+':'+dat_files[link].Extension,False); + END; + END; + +FUNCTION ExportTXAN; + VAR + loop_speed,unknown:Word; + linkcount:LongWord; + link:LongWord; + i:Byte; + BEGIN + Result:=export_noerror; + + LoadDatFilePart(fileid,$14,SizeOf(loop_speed),@loop_speed); + LoadDatFilePart(fileid,$16,SizeOf(unknown),@unknown); + ExportDefLine(fileid,'LOOPSPEED:'+FormatNumber(loop_speed,2,'0'),False); + ExportDefLine(fileid,'UNKNOWN:'+FormatNumber(unknown,2,'0'),False); + + LoadDatFilePart(fileid,$1C,SizeOf(linkcount),@linkcount); + ExportDefLine(fileid,'TXMPLINKS:'+FormatNumber(linkcount,4,'0'),False); + FOR i:=0 TO linkcount-1 DO BEGIN + LoadDatFilePart(fileid,$20+i*4,SizeOf(link),@link); + link:=link DIV 256; + IF link=0 THEN link:=fileid-1; + ExportDefLine(fileid,FormatNumber(i,4,'0')+':LINKtoTXMP:'+FormatNumber(link,5,'0')+':'+dat_files[link].Name+':'+dat_files[link].Extension,False); + END; + END; + +FUNCTION ExportTXMB; + VAR + filestream:TFileStream; + subfile:Byte; + linkcount:LongWord; + link:LongWord; + width,height:Word; + cols,rows:Word; + i:Byte; + img:TImgPackage; + data:Tdata; + BEGIN + Result:=export_noerror; + subfile:=1; + + LoadDatFilePart(fileid,$10,SizeOf(width),@width); + LoadDatFilePart(fileid,$12,SizeOf(height),@height); + LoadDatFilePart(fileid,$18,SizeOf(cols),@cols); + LoadDatFilePart(fileid,$1A,SizeOf(rows),@rows); + ExportDefLine(fileid,'WIDTH:'+FormatNumber(width,4,'0'),False); + ExportDefLine(fileid,'HEIGHT:'+FormatNumber(height,4,'0'),False); + ExportDefLine(fileid,'COLS:'+FormatNumber(cols,2,'0'),False); + ExportDefLine(fileid,'ROWS:'+FormatNumber(rows,2,'0'),False); + + LoadDatFilePart(fileid,$1C,SizeOf(linkcount),@linkcount); + ExportDefLine(fileid,'TXMPLINKS:'+FormatNumber(linkcount,4,'0'),False); + FOR i:=0 TO linkcount-1 DO BEGIN + LoadDatFilePart(fileid,$20+i*4,SizeOf(link),@link); + link:=link DIV 256; + IF link=0 THEN link:=fileid-1; + ExportDefLine(fileid,FormatNumber(i,4,'0')+':LINKtoTXMP:'+FormatNumber(link,5,'0')+':'+dat_files[link].Name+':'+dat_files[link].Extension,False); + END; + + IF convert THEN BEGIN + img:=LoadTXMBconnected(fileid); + data:=ImgdataToBmp(img.imgx,img.imgy,img.imgdepth,img.storetype,img.imgdata); + filestream:=TFileStream.Create(GetExtractPath+'\'+GetWinFileName(fileid,FormatNumber(subfile,2,'0')+'-ImgData')+'.bmp',fmCreate); + filestream.Write(data[0],Length(data)); + filestream.Free; + END; + END; + +FUNCTION ExportTXMP; + VAR + filestream:TFileStream; + subfile:Byte; + img:TImgPackage; + BEGIN + Result:=export_noerror; + subfile:=1; + + img:=LoadImgData(fileid); + + filestream:=TFileStream.Create(GetExtractPath+'\'+GetWinFileName(fileid,FormatNumber(subfile,2,'0')+'-ImgData'),fmCreate); + filestream.Write(img.imgdata[0],Length(img.imgdata)); + filestream.Free; + + IF convert THEN BEGIN + img.imgdata:=ImgdataToBMP(img.imgx,img.imgy,img.imgdepth,img.storetype,img.imgdata); + filestream:=TFileStream.Create(GetExtractPath+'\'+GetWinFileName(fileid,FormatNumber(subfile,2,'0')+'-ImgData')+'.bmp',fmCreate); + filestream.Write(img.imgdata[0],Length(img.imgdata)); + filestream.Free; + END; + END; + +END. Index: /oup/releases/0.12a/Unit5_preview.dfm =================================================================== --- /oup/releases/0.12a/Unit5_preview.dfm (revision 21) +++ /oup/releases/0.12a/Unit5_preview.dfm (revision 21) @@ -0,0 +1,74 @@ +object Form5: TForm5 + Left = 0 + Top = 0 + Width = 435 + Height = 348 + BorderStyle = bsSizeToolWin + Caption = 'Preview' + Color = clBtnFace + Font.Charset = DEFAULT_CHARSET + Font.Color = clWindowText + Font.Height = -11 + Font.Name = 'Tahoma' + Font.Style = [] + FormStyle = fsStayOnTop + OldCreateOrder = False + OnCloseQuery = FormCloseQuery + OnCreate = FormCreate + OnResize = FormResize + PixelsPerInch = 96 + TextHeight = 13 + object img: TImage + Left = 0 + Top = 20 + Width = 427 + Height = 304 + Align = alClient + end + object panel_buttons: TPanel + Left = 0 + Top = 0 + Width = 427 + Height = 20 + Align = alTop + BevelOuter = bvNone + TabOrder = 0 + Visible = False + OnResize = panel_buttonsResize + object btn_dec: TButton + Left = 0 + Top = 0 + Width = 20 + Height = 20 + Caption = '-' + Enabled = False + TabOrder = 0 + OnClick = btn_decClick + end + object btn_startstop: TButton + Left = 21 + Top = 0 + Width = 80 + Height = 20 + Caption = 'Stop automatic' + TabOrder = 1 + OnClick = btn_startstopClick + end + object btn_inc: TButton + Left = 102 + Top = 0 + Width = 20 + Height = 20 + Caption = '+' + Enabled = False + TabOrder = 2 + OnClick = btn_incClick + end + end + object timer: TTimer + Enabled = False + OnTimer = timerTimer + Left = 72 + Top = 48 + end +end Index: /oup/releases/0.12a/Unit5_preview.pas =================================================================== --- /oup/releases/0.12a/Unit5_preview.pas (revision 21) +++ /oup/releases/0.12a/Unit5_preview.pas (revision 21) @@ -0,0 +1,189 @@ +UNIT Unit5_preview; +INTERFACE +USES + Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, + Dialogs, Math, ExtCtrls, Unit2_functions, Unit3_data, Unit4_exporters, Unit6_imgfuncs, + StdCtrls; + +TYPE + TForm5 = Class(TForm) + img: TImage; + timer: TTimer; + panel_buttons: TPanel; + btn_dec: TButton; + btn_startstop: TButton; + btn_inc: TButton; + PROCEDURE btn_incClick(Sender: TObject); + PROCEDURE btn_decClick(Sender: TObject); + PROCEDURE FormResize(Sender: TObject); + PROCEDURE btn_startstopClick(Sender: TObject); + PROCEDURE panel_buttonsResize(Sender: TObject); + PROCEDURE timerTimer(Sender: TObject); + PROCEDURE FormCreate(Sender: TObject); + PROCEDURE FormCloseQuery(Sender: TObject; var CanClose: Boolean); + PROCEDURE ShowPreview(fileid:LongWord); + PRIVATE + PUBLIC + END; + +VAR + Form5: TForm5; + +IMPLEMENTATION +{$R *.dfm} +USES Unit1_main; +VAR + memstreams:Array OF TMemoryStream; + actualimg:Byte; + _fileid:LongWord; + +PROCEDURE PreviewTXMB; + VAR + data:Tdata; + img:TImgPackage; + BEGIN + SetLength(memstreams,1); + img:=LoadTXMBconnected(_fileid); + data:=ImgdataToBmp(img.imgx,img.imgy,img.imgdepth,img.storetype,img.imgdata); + + memstreams[0].Clear; + memstreams[0].Write(data[0],Length(data)); + memstreams[0].Seek(0,soFromBeginning); + + Form5.img.Picture.Bitmap.LoadFromStream(memstreams[0]); + END; + +PROCEDURE PreviewTXMP; + VAR + data:Tdata; + img:TImgPackage; + BEGIN + { + tempdata:=ResizeImage(imgx,imgy,imgdepth,tempdata); + imgx:=imgx DIV 2; + imgy:=imgy DIV 2; + datasize:=datasize DIV 4; + } + SetLength(memstreams,1); + img:=LoadImgData(_fileid); + data:=ImgdataToBmp(img.imgx,img.imgy,img.imgdepth,img.storetype,img.imgdata); + + memstreams[0].Clear; + memstreams[0].Write(data[0],Length(data)); + memstreams[0].Seek(0,soFromBeginning); + + Form5.img.Picture.Bitmap.LoadFromStream(memstreams[0]); + END; + +PROCEDURE PreviewTXAN; + VAR + loop_speed:Word; + linkcount:LongWord; + link:LongWord; + i:Byte; + data:Tdata; + img:TImgPackage; + BEGIN + LoadDatFilePart(_fileid,$14,SizeOf(loop_speed),@loop_speed); + LoadDatFilePart(_fileid,$1C,SizeOf(linkcount),@linkcount); + SetLength(memstreams,linkcount); + FOR i:=0 TO linkcount-1 DO BEGIN + LoadDatFilePart(_fileid,$20+i*4,SizeOf(link),@link); + link:=link DIV 256; + IF link=0 THEN link:=_fileid-1; + memstreams[i]:=TMemoryStream.Create; + img:=LoadImgData(link); + data:=ImgdataToBmp(img.imgx,img.imgy,img.imgdepth,img.storetype,img.imgdata); + memstreams[i].Clear; + memstreams[i].Write(data[0],Length(data)); + memstreams[i].Seek(0,soFromBeginning); + END; + actualimg:=254; + Form5.timer.Interval:=Floor(loop_speed*(1/60)*1000); + Form5.timer.Enabled:=False; + Form5.btn_startstopClick(Form5); + Form5.panel_buttons.Visible:=True; + END; + +PROCEDURE TForm5.ShowPreview(fileid:LongWord); + BEGIN + _fileid:=fileid; + Form5.timer.Enabled:=False; + Form5.panel_buttons.Visible:=False; + Form5.Caption:='Preview '+dat_files[_fileid].FileName; + IF dat_files[fileid].Extension='TXAN' THEN PreviewTXAN; + IF dat_files[fileid].Extension='TXMB' THEN PreviewTXMB; + IF dat_files[fileid].Extension='TXMP' THEN PreviewTXMP; + END; + +PROCEDURE TForm5.FormCloseQuery(Sender: TObject; var CanClose: Boolean); + BEGIN + CanClose:=False; + Form5.Visible:=False; + END; + +PROCEDURE TForm5.FormCreate(Sender: TObject); + BEGIN + SetLength(memstreams,1); + memstreams[0]:=TMemoryStream.Create; + Form5.Width:=170; + Form5.Height:=200; + END; + +PROCEDURE TForm5.timerTimer(Sender: TObject); + BEGIN + Inc(actualimg); + IF actualimg>=Length(memstreams) THEN actualimg:=0; + Form5.img.Picture.Bitmap.LoadFromStream(memstreams[actualimg]); + memstreams[actualimg].Seek(0,soFromBeginning); + Form5.Caption:='Preview '+dat_files[_fileid].FileName+' ('+IntToStr(actualimg+1)+'/'+IntToStr(Length(memstreams))+')'; + END; + +PROCEDURE TForm5.panel_buttonsResize(Sender: TObject); + BEGIN + btn_startstop.Width:=panel_buttons.Width-45; + btn_inc.Left:=panel_buttons.Width-23; + END; + +PROCEDURE TForm5.btn_startstopClick(Sender: TObject); + BEGIN + Form5.timer.Enabled:=NOT Form5.timer.Enabled; + Form5.btn_dec.Enabled:=NOT Form5.timer.Enabled; + Form5.btn_inc.Enabled:=NOT Form5.timer.Enabled; + IF Form5.timer.Enabled THEN + Form5.btn_startstop.Caption:='Stop automatic' + ELSE + Form5.btn_startstop.Caption:='Start automatic'; + END; + +PROCEDURE TForm5.FormResize(Sender: TObject); + BEGIN + IF Form5.Width>=150 THEN BEGIN + END ELSE Form5.Width:=150; + IF Form5.Height>=150 THEN BEGIN + END ELSE Form5.Height:=150; + END; + +PROCEDURE TForm5.btn_decClick(Sender: TObject); + BEGIN + IF actualimg>0 THEN + Dec(actualimg) + ELSE + actualimg:=High(memstreams); + Form5.Caption:='Preview '+dat_files[_fileid].FileName+' ('+IntToStr(actualimg+1)+'/'+IntToStr(Length(memstreams))+')'; + Form5.img.Picture.Bitmap.LoadFromStream(memstreams[actualimg]); + memstreams[actualimg].Seek(0,soFromBeginning); + END; + +PROCEDURE TForm5.btn_incClick(Sender: TObject); + BEGIN + IF actualimg0) THEN BEGIN + Inc(row_orig); + IF (row_orig MOD 2)=0 THEN BEGIN + Inc(row); + col:=0; + END; + END; + IF (row_orig MOD 2)=0 THEN BEGIN + IF (i MOD 2)=0 THEN BEGIN + FOR j:=0 TO (imgdepth DIV 8)-1 DO + temparray[((row*(oldx DIV 2))+col)*(imgdepth DIV 8)+j]:=data[i*2+j]; + Inc(col); + END; + END; + END; + Result:=temparray; + END; + + +FUNCTION RevertImage(imgx,imgy,imgdepth:LongWord; imgdata:Tdata):Tdata; + VAR + x,y,i:LongWord; + BEGIN + SetLength(Result,imgx*imgy*(imgdepth DIV 8)); + FOR y:=0 TO imgy-1 DO + FOR x:=0 TO imgx-1 DO + FOR i:=0 TO (imgdepth DIV 8)-1 DO + Result[((imgx*(imgy-1-y)+x)*(imgdepth DIV 8))+i]:= + imgdata[(imgx*y+x)*(imgdepth DIV 8)+i]; + END; + + +FUNCTION DecompressImage(imgx,imgy:LongWord; imgdata:Tdata):Tdata; + TYPE + Tcolor=RECORD + RGBb:Byte; + RGBg:Byte; + RGBr:Byte; + RGBa:Byte; + END; + VAR + i,j,x,y:LongWord; + color:Array[1..4] OF Tcolor; + pixel:Array[1..16] OF Byte; + BEGIN + x:=0; + y:=0; + SetLength(Result,imgx*imgy*4); + FOR i:=0 TO ((imgx*imgy) DIV 16)-1 DO BEGIN + Color[1].RGBb:=Floor(((imgdata[(i*8)+0]+imgdata[(i*8)+1]*256) AND $001F) / $001F * 255); + Color[1].RGBg:=Floor(((imgdata[(i*8)+0]+imgdata[(i*8)+1]*256) AND $07E0) / $07E0 * 255); + Color[1].RGBr:=Floor(((imgdata[(i*8)+0]+imgdata[(i*8)+1]*256) AND $F800) / $F800 * 255); + Color[1].RGBa:=255; + Color[2].RGBb:=Floor(((imgdata[(i*8)+2]+imgdata[(i*8)+3]*256) AND $001F) / $001F * 255); + Color[2].RGBg:=Floor(((imgdata[(i*8)+2]+imgdata[(i*8)+3]*256) AND $07E0) / $07E0 * 255); + Color[2].RGBr:=Floor(((imgdata[(i*8)+2]+imgdata[(i*8)+3]*256) AND $F800) / $F800 * 255); + Color[2].RGBa:=255; + Color[3].RGBb:=Floor( Color[1].RGBb/3*2 + Color[2].RGBb/3 ); + Color[3].RGBg:=Floor( Color[1].RGBg/3*2 + Color[2].RGBg/3 ); + Color[3].RGBr:=Floor( Color[1].RGBr/3*2 + Color[2].RGBr/3 ); + Color[3].RGBa:=255; + Color[4].RGBb:=Floor( Color[1].RGBb/3 + Color[2].RGBb/3*2 ); + Color[4].RGBg:=Floor( Color[1].RGBg/3 + Color[2].RGBg/3*2 ); + Color[4].RGBr:=Floor( Color[1].RGBr/3 + Color[2].RGBr/3*2 ); + Color[4].RGBa:=255; + Pixel[1]:=Floor( (imgdata[(i*8)+4] AND $C0) / $40 + 1 ); + Pixel[2]:=Floor( (imgdata[(i*8)+4] AND $30) / $10 + 1 ); + Pixel[3]:=Floor( (imgdata[(i*8)+4] AND $0C) / $04 + 1 ); + Pixel[4]:=Floor( (imgdata[(i*8)+4] AND $03) + 1 ); + Pixel[5]:=Floor( (imgdata[(i*8)+5] AND $C0) / $40 + 1 ); + Pixel[6]:=Floor( (imgdata[(i*8)+5] AND $30) / $10 + 1 ); + Pixel[7]:=Floor( (imgdata[(i*8)+5] AND $0C) / $04 + 1 ); + Pixel[8]:=Floor( (imgdata[(i*8)+5] AND $03) + 1 ); + Pixel[9]:=Floor( (imgdata[(i*8)+6] AND $C0) / $40 + 1 ); + Pixel[10]:=Floor( (imgdata[(i*8)+6] AND $30) / $10 + 1 ); + Pixel[11]:=Floor( (imgdata[(i*8)+6] AND $0C) / $04 + 1 ); + Pixel[12]:=Floor( (imgdata[(i*8)+6] AND $03) + 1 ); + Pixel[13]:=Floor( (imgdata[(i*8)+7] AND $C0) / $40 + 1 ); + Pixel[14]:=Floor( (imgdata[(i*8)+7] AND $30) / $10 + 1 ); + Pixel[15]:=Floor( (imgdata[(i*8)+7] AND $0C) / $04 + 1 ); + Pixel[16]:=Floor( (imgdata[(i*8)+7] AND $03) + 1 ); + FOR j:=0 TO 3 DO BEGIN + Result[((y+3)*imgx+x+j)*3+0]:=Color[Pixel[16-j]].RGBb; + Result[((y+3)*imgx+x+j)*3+1]:=Color[Pixel[16-j]].RGBg; + Result[((y+3)*imgx+x+j)*3+2]:=Color[Pixel[16-j]].RGBr; + END; + FOR j:=0 TO 3 DO BEGIN + Result[((y+2)*imgx+x+j)*3+0]:=Color[Pixel[12-j]].RGBb; + Result[((y+2)*imgx+x+j)*3+1]:=Color[Pixel[12-j]].RGBg; + Result[((y+2)*imgx+x+j)*3+2]:=Color[Pixel[12-j]].RGBr; + END; + FOR j:=0 TO 3 DO BEGIN + Result[((y+1)*imgx+x+j)*3+0]:=Color[Pixel[8-j]].RGBb; + Result[((y+1)*imgx+x+j)*3+1]:=Color[Pixel[8-j]].RGBg; + Result[((y+1)*imgx+x+j)*3+2]:=Color[Pixel[8-j]].RGBr; + END; + FOR j:=0 TO 3 DO BEGIN + Result[((y+0)*imgx+x+j)*3+0]:=Color[Pixel[4-j]].RGBb; + Result[((y+0)*imgx+x+j)*3+1]:=Color[Pixel[4-j]].RGBg; + Result[((y+0)*imgx+x+j)*3+2]:=Color[Pixel[4-j]].RGBr; + END; + x:=x+4; + IF x=imgx THEN BEGIN + y:=y+4; + x:=0; + END; + END; + END; + + +FUNCTION ImgdataToBmp(imgx,imgy,imgdepth,storetype:LongWord; imgdata:Tdata):Tdata; + CONST BMPheader:Array[0..53] OF Byte= + ($42,$4D,0,0,0,0,0,0,0,0,54,0,0,0, + 40,0,0,0,0,0,0,0,0,0,0,0,1,0,$18,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0); + VAR + i,x,y:LongWord; + BEGIN + CASE storetype OF + 0: BEGIN + SetLength(Result,imgx*imgy*3); + FOR y:=0 TO imgy-1 DO BEGIN + FOR x:=0 TO imgx-1 DO BEGIN + Result[((imgx*y+x)*3)+0]:=Floor( ( (imgdata[(imgx*y+x)*2]+imgdata[(imgx*y+x)*2+1]*256) AND $000F ) / $000F * 255); + Result[((imgx*y+x)*3)+1]:=Floor( ( (imgdata[(imgx*y+x)*2]+imgdata[(imgx*y+x)*2+1]*256) AND $00F0 ) / $00F0 * 255); + Result[((imgx*y+x)*3)+2]:=Floor( ( (imgdata[(imgx*y+x)*2]+imgdata[(imgx*y+x)*2+1]*256) AND $0F00 ) / $0F00 * 255); + END; + END; + END; + 1,2,8: BEGIN + SetLength(Result,imgx*imgy*3); + FOR y:=0 TO imgy-1 DO BEGIN + FOR x:=0 TO imgx-1 DO BEGIN + Result[((imgx*y+x)*3)+0]:=Floor( ( (imgdata[(imgx*y+x)*2]+imgdata[(imgx*y+x)*2+1]*256) AND $001F ) / $001F * 255); + Result[((imgx*y+x)*3)+1]:=Floor( ( (imgdata[(imgx*y+x)*2]+imgdata[(imgx*y+x)*2+1]*256) AND $03E0 ) / $03E0 * 255); + Result[((imgx*y+x)*3)+2]:=Floor( ( (imgdata[(imgx*y+x)*2]+imgdata[(imgx*y+x)*2+1]*256) AND $7C00 ) / $7C00 * 255); + END; + END; + END; + 9: BEGIN + Result:=DecompressImage(imgx,imgy,imgdata); + END; + END; + Result:=RevertImage(imgx,imgy,24,Result); + SetLength(Result,imgx*imgy*3+54); + FOR i:=High(Result)-54 DOWNTO 0 DO Result[i+54]:=Result[i]; + + FOR i:=0 TO High(BMPheader) DO Result[i]:=BMPheader[i]; + Result[2]:=((imgx*imgy*3+54) AND $000000FF); + Result[3]:=((imgx*imgy*3+54) AND $0000FF00) DIV $100; + Result[4]:=((imgx*imgy*3+54) AND $00FF0000) DIV $10000; + Result[5]:=((imgx*imgy*3+54) AND $FF000000) DIV $1000000; + Result[18]:=(imgx AND $000000FF) DIV $1; + Result[19]:=(imgx AND $0000FF00) DIV $100; + Result[20]:=(imgx AND $00FF0000) DIV $10000; + Result[21]:=(imgx AND $FF000000) DIV $1000000; + Result[22]:=(imgy AND $000000FF) DIV $1; + Result[23]:=(imgy AND $0000FF00) DIV $100; + Result[24]:=(imgy AND $00FF0000) DIV $10000; + Result[25]:=(imgy AND $FF000000) DIV $1000000; + Result[34]:=((imgx*imgy*3) AND $000000FF) DIV $1; + Result[35]:=((imgx*imgy*3) AND $0000FF00) DIV $100; + Result[36]:=((imgx*imgy*3) AND $00FF0000) DIV $10000; + Result[37]:=((imgx*imgy*3) AND $FF000000) DIV $1000000; + END; + +FUNCTION BmpToImgdata(bmpdata:Tdata):TImgPackage; + VAR + x,y:LongWord; + r24,g24,b24:Word; + r16,g16,b16:Word; + gesamt:Word; + BEGIN + Result.imgdepth:=0; + IF NOT((bmpdata[00]=$42) AND (bmpdata[01]=$4D)) THEN BEGIN + ShowMessage('Not a standard 24bit bitmap'); + Exit; + END; + IF NOT(bmpdata[10]=54) THEN BEGIN + ShowMessage('Imagedata has to start at 0x54'); + Exit; + END; + IF NOT(bmpdata[14]=40) THEN BEGIN + ShowMessage('Second bitmap header has to have 40 bytes'); + Exit; + END; + IF NOT(bmpdata[28]=24) THEN BEGIN + ShowMessage('Bitmap has to have 24bits'); + Exit; + END; + IF NOT(bmpdata[30]=0) THEN BEGIN + ShowMessage('Bitmap has to be uncompressed'); + Exit; + END; + Result.imgx:=bmpdata[18]+bmpdata[19]*256+bmpdata[20]*256*256+bmpdata[21]*256*256*256; + Result.imgy:=bmpdata[22]+bmpdata[23]*256+bmpdata[24]*256*256+bmpdata[25]*256*256*256; + Result.imgdepth:=16; + Result.storetype:=1; + + SetLength(Result.imgdata,Result.imgx*Result.imgy*2); + FOR y:=0 TO Result.imgy-1 DO BEGIN + FOR x:=0 TO Result.imgx-1 DO BEGIN + r24:=bmpdata[54+(Result.imgx*y+x)*3+0]; + g24:=bmpdata[54+(Result.imgx*y+x)*3+1]; + b24:=bmpdata[54+(Result.imgx*y+x)*3+2]; + r16:=(Ceil(r24*$001F/255)) AND $001F; + g16:=(Ceil(g24*$03E0/255)) AND $03E0; + b16:=(Ceil(b24*$7C00/255)) AND $7C00; + gesamt:=r16+g16+b16; + Result.imgdata[((Result.imgx*y+x)*2)+0]:=gesamt AND $00FF; + Result.imgdata[((Result.imgx*y+x)*2)+1]:=(gesamt AND $FF00) DIV 256; + END; + END; + + Result.imgdata:=RevertImage(Result.imgx,Result.imgy,Result.imgdepth,Result.imgdata); + END; + +FUNCTION LoadTXMBconnected(fileid:LongWord):TImgPackage; + VAR + i,x,y,x2,y2,pixelid,imgid:LongWord; + rows,cols:Word; + linkcount:LongWord; + link:LongWord; + single_image:TImgPackage; + images_decoded:Array OF TImgPackage; + x_start,y_start:LongWord; + BEGIN + LoadDatFilePart(fileid,$10,SizeOf(Result.imgx),@Result.imgx); + LoadDatFilePart(fileid,$12,SizeOf(Result.imgy),@Result.imgy); + LoadDatFilePart(fileid,$18,SizeOf(cols),@cols); + LoadDatFilePart(fileid,$1A,SizeOf(rows),@rows); + LoadDatFilePart(fileid,$1C,SizeOf(linkcount),@linkcount); + SetLength(images_decoded,linkcount); + FOR i:=0 TO linkcount-1 DO BEGIN + LoadDatFilePart(fileid,$20+i*4,SizeOf(link),@link); + link:=link DIV 256; + single_image:=LoadImgData(link); + images_decoded[i]:=BmpToImgdata(ImgdataToBmp(single_image.imgx,single_image.imgy,single_image.imgdepth,single_image.storetype,single_image.imgdata)); + END; + SetLength(Result.imgdata,Result.imgx*Result.imgy*2); + FOR y:=0 TO rows-1 DO BEGIN + FOR x:=0 TO cols-1 DO BEGIN + imgid:=y*cols+x; + x_start:=0; + y_start:=0; + FOR i:=0 TO x DO IF i=400 THEN BEGIN + END ELSE Form7.Width:=400; + IF Form7.Height>=350 THEN BEGIN + END ELSE Form7.Height:=350; + END; + +PROCEDURE TForm7.list_txmpClick(Sender: TObject); + VAR + id:LongWord; + data:Tdata; + img:TImgPackage; + mem:TMemoryStream; + BEGIN + id:=StrToInt(MidStr(list_txmp.Items.Strings[list_txmp.ItemIndex],1,5)); + + img:=LoadImgData(id); + data:=ImgdataToBmp(img.imgx,img.imgy,img.imgdepth,img.storetype,img.imgdata); + + mem:=TMemoryStream.Create; + mem.Write(data[0],Length(data)); + mem.Seek(0,soFromBeginning); + Form7.image_txmppreview.Picture.Bitmap.LoadFromStream(mem); + mem.Free; + + Form7.group_bmpselect.Enabled:=True; + END; + +PROCEDURE TForm7.btn_loadClick(Sender: TObject); + VAR + bmpfile:TFileStream; + mem:TMemoryStream; + BEGIN + IF opend.Execute THEN BEGIN + bmpfile:=TFileStream.Create(opend.FileName, fmOpenRead); + SetLength(actual_bmpdata,bmpfile.Size); + bmpfile.Read(actual_bmpdata[0],bmpfile.Size); + bmpfile.Free; + + mem:=TMemoryStream.Create; + mem.Write(actual_bmpdata[0],Length(actual_bmpdata)); + mem.Seek(0,soFromBeginning); + Form7.image_bmppreview.Picture.Bitmap.LoadFromStream(mem); + mem.Free; + + Form7.panel_main.Enabled:=True; + END; + END; + +PROCEDURE TForm7.btn_replaceClick(Sender: TObject); + VAR + id:LongWord; + imgpkg:TImgPackage; + rawfile:TFileStream; + datfile:TFileStream; + dataddr:LongWord; + new_rawaddr:LongWord; + oldwidth,oldheight:Word; + datword:Word; + BEGIN + IF Form7.list_txmp.ItemIndex>=0 THEN BEGIN + imgpkg:=BmpToImgdata(actual_bmpdata); + rawfile:=TFileStream.Create(raw_filename,fmOpenReadWrite); + datfile:=TFileStream.Create(dat_filename,fmOpenReadWrite); + + id:=StrToInt(MidStr(list_txmp.Items.Strings[list_txmp.ItemIndex],1,5)); + dataddr:=dat_files[id].dataddr; + datfile.Seek(dataddr+$8C,soFromBeginning); + datfile.Read(oldwidth,2); + datfile.Seek(dataddr+$8E,soFromBeginning); + datfile.Read(oldheight,2); + IF (oldwidth<>imgpkg.imgx) OR (oldheight<>imgpkg.imgy) THEN BEGIN + IF MessageBox(Form7.Handle, + PChar('Current image and new image have different size'+CrLf+ + '(Current: '+IntToStr(oldwidth)+'x'+IntToStr(oldheight)+ + ' - New: '+IntToStr(imgpkg.imgx)+'x'+IntToStr(imgpkg.imgy)+')'+CrLf+ + 'Replace anyways?'), + PChar('Really replace?'), + MB_YESNO)=IDNO THEN Exit; + END; + new_rawaddr:=rawfile.Size; + + datword:=$1000; + datfile.Seek(dataddr+$88,soFromBeginning); + datfile.Write(datword,2); + datfile.Seek(dataddr+$8C,soFromBeginning); + datfile.Write(imgpkg.imgx,2); + datfile.Seek(dataddr+$8E,soFromBeginning); + datfile.Write(imgpkg.imgy,2); + datword:=$0001; + datfile.Seek(dataddr+$90,soFromBeginning); + datfile.Write(datword,2); + datfile.Seek(dataddr+$9C,soFromBeginning); + datfile.Write(new_rawaddr,4); + datfile.Free; + + rawfile.Seek(new_rawaddr,soFromBeginning); + rawfile.Write(imgpkg.imgdata[0],Length(imgpkg.imgdata)); + rawfile.Free; + END; + END; + +END. Index: /oup/releases/0.13a/OniUnPacker.bdsproj =================================================================== --- /oup/releases/0.13a/OniUnPacker.bdsproj (revision 21) +++ /oup/releases/0.13a/OniUnPacker.bdsproj (revision 21) @@ -0,0 +1,171 @@ + + + + + + + + + + + + OniUnPacker.dpr + + + 7.0 + + + 8 + 0 + 1 + 1 + 0 + 0 + 1 + 1 + 1 + 0 + 0 + 1 + 0 + 1 + 1 + 1 + 0 + 0 + 0 + 0 + 0 + 1 + 0 + 1 + 1 + 1 + True + True + WinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE; + + False + + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + False + False + False + True + True + True + + + 0 + 0 + 1 + False + False + False + 16384 + 1048576 + 4194304 + + + + + + + + + xmlrtl;rtl;vcl;vclie;inet;inetdbbde;inetdbxpress;vclx;IndySystem;IndyCore;dbrtl;dsnap;soaprtl;IndyProtocols;bdertl;vcldbx;vcldb;webdsnap;websnap;vclactnband;GridPackd2005;TWrapGrid;Package1;A406_R70;CoolTrayIcon_D6plus + + + False + + + + + + False + + + + + + False + + + False + False + 1 + 0 + 0 + 0 + False + False + False + False + False + 1031 + 1252 + + + + + 1.0.0.0 + + + + + + 1.0.0.0 + + + (untitled) + Borland Web Wizard Package + + + Index: /oup/releases/0.13a/OniUnPacker.cfg =================================================================== --- /oup/releases/0.13a/OniUnPacker.cfg (revision 21) +++ /oup/releases/0.13a/OniUnPacker.cfg (revision 21) @@ -0,0 +1,38 @@ +-$A8 +-$B- +-$C+ +-$D+ +-$E- +-$F- +-$G+ +-$H+ +-$I+ +-$J- +-$K- +-$L+ +-$M- +-$N+ +-$O+ +-$P+ +-$Q- +-$R- +-$S- +-$T- +-$U- +-$V+ +-$W- +-$X+ +-$YD +-$Z1 +-cg +-AWinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE; +-H+ +-W+ +-M +-$M16384,1048576 +-K$00400000 +-LE"C:\Dokumente und Einstellungen\Administrator\Eigene Dateien\Borland Studio Projects\Bpl" +-LN"C:\Dokumente und Einstellungen\Administrator\Eigene Dateien\Borland Studio Projects\Bpl" +-w-UNSAFE_TYPE +-w-UNSAFE_CODE +-w-UNSAFE_CAST Index: /oup/releases/0.13a/OniUnPacker.dpr =================================================================== --- /oup/releases/0.13a/OniUnPacker.dpr (revision 21) +++ /oup/releases/0.13a/OniUnPacker.dpr (revision 21) @@ -0,0 +1,21 @@ +PROGRAM OniUnPacker; +uses + Forms, + Unit1_main in 'Unit1_main.pas' {Form1}, + Unit2_functions in 'Unit2_functions.pas', + Unit3_data in 'Unit3_data.pas', + Unit4_Exporters in 'Unit4_Exporters.pas', + Unit5_preview in 'Unit5_preview.pas' {Form5}, + Unit6_imgfuncs in 'Unit6_imgfuncs.pas', + Unit7_txmpreplace in 'Unit7_txmpreplace.pas' {Form7}; + +{$R *.res} + +BEGIN + Application.Initialize; + Application.Title:='Oni Un/Packer'; + Application.CreateForm(TForm1, Form1); + Application.CreateForm(TForm5, Form5); + Application.CreateForm(TForm7, Form7); + Application.Run; +END. Index: /oup/releases/0.13a/Unit1_main.dfm =================================================================== --- /oup/releases/0.13a/Unit1_main.dfm (revision 21) +++ /oup/releases/0.13a/Unit1_main.dfm (revision 21) @@ -0,0 +1,301 @@ +object Form1: TForm1 + Left = 0 + Top = 0 + HorzScrollBar.Visible = False + VertScrollBar.Visible = False + AutoScroll = False + Caption = 'Form1' + ClientHeight = 435 + ClientWidth = 742 + Color = clBtnFace + Font.Charset = DEFAULT_CHARSET + Font.Color = clWindowText + Font.Height = -11 + Font.Name = 'Tahoma' + Font.Style = [] + Menu = menu + OldCreateOrder = False + OnClose = FormClose + OnCreate = FormCreate + OnResize = FormResize + PixelsPerInch = 96 + TextHeight = 13 + object panel_all: TPanel + Left = 0 + Top = 100 + Width = 692 + Height = 300 + BevelOuter = bvNone + TabOrder = 0 + object Splitter2: TSplitter + Left = 360 + Top = 0 + Width = 8 + Height = 300 + AutoSnap = False + Beveled = True + MinSize = 360 + OnMoved = Splitter2Moved + end + object panel_left: TPanel + Left = 0 + Top = 0 + Width = 360 + Height = 300 + Cursor = crDrag + Align = alLeft + BevelOuter = bvNone + TabOrder = 0 + object Splitter1: TSplitter + Left = 0 + Top = 241 + Width = 360 + Height = 8 + Cursor = crVSplit + Align = alTop + AutoSnap = False + Beveled = True + MinSize = 75 + OnMoved = Splitter1Moved + end + object panel_files: TPanel + Left = 0 + Top = 0 + Width = 360 + Height = 241 + Align = alTop + BevelOuter = bvNone + TabOrder = 0 + object btn_extractallconvert: TButton + Left = 273 + Top = 208 + Width = 82 + Height = 33 + Caption = 'Extract all (with convert)' + TabOrder = 0 + WordWrap = True + OnClick = btn_extractallconvertClick + end + object btn_extract: TButton + Left = 0 + Top = 208 + Width = 100 + Height = 33 + Caption = 'Extract file (without convert)' + TabOrder = 1 + WordWrap = True + OnClick = btn_extractconvertClick + end + object btn_extractconvert: TButton + Left = 101 + Top = 208 + Width = 105 + Height = 33 + Caption = 'Extract file (with convert if possible)' + TabOrder = 2 + WordWrap = True + OnClick = btn_extractconvertClick + end + object list_files: TListBox + Left = 0 + Top = 0 + Width = 360 + Height = 209 + Align = alTop + Font.Charset = DEFAULT_CHARSET + Font.Color = clWindowText + Font.Height = -11 + Font.Name = 'Fixedsys' + Font.Style = [] + ItemHeight = 15 + ParentFont = False + TabOrder = 3 + OnClick = list_filesDblClick + OnDblClick = list_filesDblClick + end + object btn_extractall: TButton + Left = 210 + Top = 208 + Width = 62 + Height = 33 + Caption = 'Extract all' + TabOrder = 4 + WordWrap = True + OnClick = btn_extractallconvertClick + end + end + object list_extensions: TListBox + Left = 0 + Top = 249 + Width = 360 + Height = 51 + Align = alClient + Font.Charset = DEFAULT_CHARSET + Font.Color = clWindowText + Font.Height = -11 + Font.Name = 'Fixedsys' + Font.Style = [] + ItemHeight = 15 + ParentFont = False + Sorted = True + TabOrder = 1 + OnClick = list_extensionsClick + OnDblClick = list_extensionsClick + end + end + object panel_right: TPanel + Left = 368 + Top = 0 + Width = 324 + Height = 300 + Align = alClient + BevelOuter = bvNone + TabOrder = 1 + object Splitter3: TSplitter + Left = 0 + Top = 200 + Width = 324 + Height = 8 + Cursor = crVSplit + Align = alTop + AutoSnap = False + Beveled = True + MinSize = 75 + end + object edit_data: TMemo + Left = 0 + Top = 0 + Width = 324 + Height = 200 + Align = alTop + Font.Charset = DEFAULT_CHARSET + Font.Color = clWindowText + Font.Height = -13 + Font.Name = 'Fixedsys' + Font.Style = [] + ParentFont = False + ReadOnly = True + ScrollBars = ssVertical + TabOrder = 0 + WordWrap = False + end + object list_names: TListBox + Left = 0 + Top = 208 + Width = 324 + Height = 92 + Align = alClient + Font.Charset = DEFAULT_CHARSET + Font.Color = clWindowText + Font.Height = -11 + Font.Name = 'Fixedsys' + Font.Style = [] + ItemHeight = 15 + ParentFont = False + Sorted = True + TabOrder = 1 + end + end + end + object panel_info: TPanel + Left = 0 + Top = 0 + Width = 742 + Height = 100 + Align = alTop + BevelOuter = bvNone + TabOrder = 1 + object lbl_info: TLabel + Left = 2 + Top = 26 + Width = 345 + Height = 73 + AutoSize = False + end + object lbl_fileinfo: TLabel + Left = 380 + Top = 0 + Width = 345 + Height = 99 + AutoSize = False + end + object btn_load: TButton + Left = 0 + Top = 0 + Width = 81 + Height = 25 + Caption = 'Load dat-file' + TabOrder = 0 + OnClick = btn_loadClick + end + object btn_hexcopy: TButton + Left = 295 + Top = 64 + Width = 89 + Height = 33 + Caption = 'Copy filedata as hex to clipboard' + TabOrder = 1 + WordWrap = True + OnClick = btn_hexcopyClick + end + end + object group_progress: TGroupBox + Left = 160 + Top = 384 + Width = 297 + Height = 57 + Caption = 'Extracting...' + TabOrder = 2 + Visible = False + object lbl_progress: TLabel + Left = 10 + Top = 36 + Width = 279 + Height = 18 + AutoSize = False + end + object progress: TProgressBar + Left = 8 + Top = 16 + Width = 217 + Height = 17 + Step = 1 + TabOrder = 0 + end + object btn_extractcancel: TButton + Left = 232 + Top = 16 + Width = 57 + Height = 33 + Caption = 'Cancel' + TabOrder = 1 + OnClick = btn_extractcancelClick + end + end + object fopen: TOpenDialog + Filter = 'Oni-Dat-Files|*.dat|Oni-Sep-Files (MAC)|*.sep' + Left = 72 + end + object menu: TMainMenu + AutoHotkeys = maManual + Left = 128 + object menu_main: TMenuItem + Caption = 'Main' + object menu_exit: TMenuItem + Caption = 'Exit' + OnClick = menu_exitClick + end + end + object menu_tools: TMenuItem + Caption = 'Tools' + object menu_txmpreplace: TMenuItem + Caption = 'TXMP replacer' + OnClick = menu_txmpreplaceClick + end + end + object menu_preview: TMenuItem + Caption = 'Preview Window' + OnClick = menu_previewClick + end + end +end Index: /oup/releases/0.13a/Unit1_main.pas =================================================================== --- /oup/releases/0.13a/Unit1_main.pas (revision 21) +++ /oup/releases/0.13a/Unit1_main.pas (revision 21) @@ -0,0 +1,383 @@ +UNIT Unit1_main; +INTERFACE +USES + Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, + Dialogs, StdCtrls, StrUtils, Clipbrd, ExtCtrls, ComCtrls, Menus, + Unit2_functions, Unit3_data, Unit5_preview, Unit7_txmpreplace; + +TYPE + TForm1 = Class(TForm) + panel_all: TPanel; + panel_left: TPanel; + Splitter1: TSplitter; + panel_files: TPanel; + btn_extractallconvert: TButton; + btn_extract: TButton; + btn_extractconvert: TButton; + list_files: TListBox; + btn_extractall: TButton; + list_extensions: TListBox; + Splitter2: TSplitter; + panel_right: TPanel; + edit_data: TMemo; + list_names: TListBox; + Splitter3: TSplitter; + panel_info: TPanel; + lbl_info: TLabel; + btn_load: TButton; + btn_hexcopy: TButton; + fopen: TOpenDialog; + lbl_fileinfo: TLabel; + group_progress: TGroupBox; + progress: TProgressBar; + lbl_progress: TLabel; + menu: TMainMenu; + menu_main: TMenuItem; + menu_exit: TMenuItem; + menu_preview: TMenuItem; + btn_extractcancel: TButton; + menu_tools: TMenuItem; + menu_txmpreplace: TMenuItem; + PROCEDURE menu_txmpreplaceClick(Sender: TObject); + PROCEDURE menu_exitClick(Sender: TObject); + PROCEDURE btn_extractcancelClick(Sender: TObject); + PROCEDURE menu_previewClick(Sender: TObject); + PROCEDURE btn_extractallconvertClick(Sender: TObject); + PROCEDURE Splitter2Moved(Sender: TObject); + PROCEDURE Splitter1Moved(Sender: TObject); + PROCEDURE FormClose(Sender: TObject; var Action: TCloseAction); + PROCEDURE btn_hexcopyClick(Sender: TObject); + PROCEDURE list_extensionsClick(Sender: TObject); + PROCEDURE FormResize(Sender: TObject); + PROCEDURE btn_extractconvertClick(Sender: TObject); + PROCEDURE FormCreate(Sender: TObject); + PROCEDURE list_filesDblClick(Sender: TObject); + PROCEDURE btn_loadClick(Sender: TObject); + PRIVATE + PUBLIC + END; + +VAR + Form1: TForm1; + +IMPLEMENTATION +{$R *.dfm} + +PROCEDURE DoAfterLoadOfADat; + VAR + i:LongWord; + txt:Text; + temp4:LongWord; + temp2:Word; + temp1:Byte; + BEGIN + IF NOT DirectoryExists(GetExtractPath) THEN + CreateDir(GetExtractPath); + AssignFile(txt,GetExtractPath+'\___TXMP-FILES___.TXT'); + ReWrite(txt); + FOR i:=0 TO dat_header.Extensions-1 DO BEGIN + IF (dat_extensionsmap[i].Extension[3]='T') AND + (dat_extensionsmap[i].Extension[2]='X') AND + (dat_extensionsmap[i].Extension[1]='M') AND + (dat_extensionsmap[i].Extension[0]='P') THEN BEGIN + WriteLn(txt, FormatNumber(dat_extensionsmap[i].ExtCount,4,'0')+' TXMP-Files'); + Break; + END; + END; + WriteLn(txt,'FileName'+#9+'MipMap'+#9+'Depth'+#9+'ImgX'+#9+'ImgY'+#9+'StoreT'); + FOR i:=0 TO dat_header.Files-1 DO BEGIN + IF dat_files[i].Extension='TXMP' THEN BEGIN + Write(txt,dat_files[i].FileName+#9); + LoadDatFilePart(i,$88,1,@temp1); + Write(txt,IntToHex(temp1,2)+#9); + LoadDatFilePart(i,$89,1,@temp1); + Write(txt,IntToHex(temp1,2)+#9); + LoadDatFilePart(i,$8C,2,@temp2); + Write(txt,IntToHex(temp2,4)+#9); + LoadDatFilePart(i,$8E,2,@temp2); + Write(txt,IntToHex(temp2,4)+#9); + LoadDatFilePart(i,$90,1,@temp1); + Write(txt,IntToHex(temp1,2)+#9); + WriteLn(txt,''); + END; + END; + CloseFile(txt); + + IF NOT DirectoryExists(GetExtractPath) THEN + CreateDir(GetExtractPath); + AssignFile(txt,GetExtractPath+'\___TXAN-FILES___.TXT'); + ReWrite(txt); + FOR i:=0 TO dat_header.Extensions-1 DO BEGIN + IF (dat_extensionsmap[i].Extension[3]='T') AND + (dat_extensionsmap[i].Extension[2]='X') AND + (dat_extensionsmap[i].Extension[1]='A') AND + (dat_extensionsmap[i].Extension[0]='N') THEN BEGIN + WriteLn(txt, FormatNumber(dat_extensionsmap[i].ExtCount,4,'0')+' TXAN-Files'); + Break; + END; + END; + WriteLn(txt,'FileName'+#9+'Loopspeed'+#9+'Unknown'+#9+'Links'); + FOR i:=0 TO dat_header.Files-1 DO BEGIN + IF dat_files[i].Extension='TXAN' THEN BEGIN + Write(txt,dat_files[i].FileName+#9); + LoadDatFilePart(i,$14,2,@temp2); + Write(txt,IntToHex(temp2,4)+#9); + LoadDatFilePart(i,$16,2,@temp2); + Write(txt,IntToHex(temp2,4)+#9); + LoadDatFilePart(i,$1C,4,@temp4); + Write(txt,IntToHex(temp4,8)+#9); + WriteLn(txt,''); + END; + END; + CloseFile(txt); + END; + +PROCEDURE TForm1.btn_loadClick(Sender: TObject); + VAR i:LongWord; + BEGIN + fopen.InitialDir:=AppSettings.DatPath; + IF fopen.Execute THEN BEGIN + Form1.Caption:='Oni Un/Packer '+version+' ('+ExtractFileName(fopen.FileName)+')'; + AppSettings.DatPath:=ExtractFilepath(fopen.FileName); + list_files.Items.Clear; + list_extensions.Items.Clear; + list_names.Items.Clear; + IF LoadDatInfos(fopen.FileName) THEN BEGIN + lbl_info.Caption:= + '# of files: '+IntToStr(dat_header.Files)+CrLf+ + '# of named files: '+IntToStr(dat_header.NamedFiles)+CrLf+ + '# of extensions: '+IntToStr(dat_header.Extensions)+CrLf+ + 'Address of Body: 0x'+IntToHex(dat_header.DataAddr,8)+CrLf+ + 'Address of End: 0x'+IntToHex(dat_header.NamesAddr,8); + list_extensions.Items.Add('_All files: '+FormatNumber(dat_header.Files,4,' ')); + FOR i:=0 TO dat_header.Extensions-1 DO BEGIN + WITH dat_extensionsmap[i] DO BEGIN + list_extensions.Items.Add( + Extension[3]+Extension[2]+Extension[1]+Extension[0]+': '+ + FormatNumber(ExtCount,4,' '));{+' (Ident: 0x'+ + IntToHex(Ident[7],2)+IntToHex(Ident[6],2)+IntToHex(Ident[5],2)+IntToHex(Ident[4],2)+IntToHex(Ident[3],2)+IntToHex(Ident[2],2)+IntToHex(Ident[1],2)+IntToHex(Ident[0],2)+')');} + END; + END; + FOR i:=0 TO dat_header.namedFiles-1 DO BEGIN + WITH dat_namedfilesmap[i] DO BEGIN + list_names.Items.Add('0x'+IntToHex(filenumber,8)+': 0x'+IntToHex(blubb,8)); + END; + END; + Form1.list_extensions.ItemIndex:=0; + Form1.list_extensionsClick(Form1); + Form1.list_files.ItemIndex:=0; + Form1.list_filesDblClick(Form1); + + Form7.RecreateTXMPlist; + + DoAfterLoadOfADat; + + END ELSE BEGIN + ShowMessage('Error while loading the file:'+CrLf+fopen.FileName+CrLf+'Perhaps not an Oni-.dat-file?'); + END; + END; + END; + +PROCEDURE TForm1.list_filesDblClick(Sender: TObject); + VAR + id:LongWord; + temp:Tdata; + BEGIN + id:=StrToInt(MidStr(list_files.Items.Strings[list_files.ItemIndex],1,5)); + lbl_fileinfo.Caption:= + 'Filename: '+dat_files[id].FileName+CrLf+ + 'Size: '+FormatFileSize(dat_files[id].Size)+' ('+IntToStr(dat_files[id].Size)+' Bytes)'+CrLf+ + 'FileType: 0x'+IntToHex(dat_files[id].FileType,8)+CrLf+ + 'Address in .dat: 0x'+IntTohex(dat_files[id].DatAddr,8); + IF (dat_files[id].FileType AND $02)=0 THEN BEGIN + temp:=LoadDatFile(id); + edit_data.Text:=CreateHexString(temp,False); + btn_hexcopy.Visible:=True; + IF Form5.Visible THEN Form5.ShowPreview(id); + END ELSE BEGIN + edit_data.Text:='Zero byte file.'+CrLf+'Oni will take the data for this file of level0_final.dat/raw'; + btn_hexcopy.Visible:=False; + END; + END; + +PROCEDURE TForm1.FormCreate(Sender: TObject); + BEGIN + Form1.Caption:='Oni Un/Packer '+version; + Form1.FormResize(Form1); + + panel_all.Align:=alClient; + + IF FileExists(ExtractFilepath(Application.EXEname)+'\oniunpacker.ini') THEN BEGIN + AssignFile(AppSettingsFile,ExtractFilepath(Application.EXEname)+'\oniunpacker.ini'); + Reset(AppSettingsFile); + Read(AppSettingsFile,AppSettings); + CloseFile(AppSettingsFile); + END ELSE BEGIN + AppSettings.DatPath:='D:\Spiele\Oni\GameDataFolder'; + AppSettings.ExtractPath:='C:\Dokumente und Einstellungen\Administrator\Desktop'; + END; + + //Form1.btn_loadClick(Form1); + END; + +PROCEDURE TForm1.btn_extractconvertClick(Sender: TObject); + VAR + result:Integer; + id:LongWord; + BEGIN + id:=StrToInt(MidStr(list_files.Items.Strings[list_files.ItemIndex],1,5)); + IF TComponent(Sender).Name='btn_extract' THEN + result:=ExportFile(id,False) + ELSE + result:=ExportFile(id,True); + CASE result OF + 0{export_noerror}: IF 1=2 THEN BEGIN END; + 1{export_nohandler}: ShowMessage('No export-handler for files with extension '+dat_files[id].Extension+'.'); + 2{export_handlererror}: ShowMessage('Error while running data-handler for '+CrLf+dat_files[id].FileName); + 3{export_error}: ShowMessage('Error while exporting file '+CrLf+dat_files[id].FileName); + ELSE ShowMessage('Couldn''t export file '+FormatNumber(id,5,'0')+CrLf+'(Unknown error)'); + END; + Form1.list_files.SetFocus; + END; + +PROCEDURE TForm1.FormResize(Sender: TObject); + CONST + MinWidth:Integer=750; + MinHeight:Integer=500; + BEGIN + IF NOT group_progress.Visible THEN BEGIN + IF Form1.Width0 THEN Inc(errors); + IF (i MOD 25)=0 THEN BEGIN + lbl_progress.Caption:=IntToStr(i)+'/'+IntToStr(dat_header.Files); + progress.Position:=i; + Application.ProcessMessages; + IF btn_extractcancel.Caption='Cancel_' THEN BEGIN + btn_extractcancel.Caption:='Cancel'; + Break; + END; + END; + END; + IF errors>0 THEN + ShowMessage(IntToStr(errors)+' errors encountered.'); + + Form1.Width:=oldwidth; + Form1.Height:=oldheight; + Form1.WindowState:=oldstate; + //FOR i:=0 TO menu.ComponentCount DO menu.Items.Items[i].Enabled:=True; + panel_all.Visible:=True; + panel_info.Visible:=True; + group_progress.Visible:=False; + END; + +PROCEDURE TForm1.menu_previewClick(Sender: TObject); + BEGIN + Form5.Visible:=NOT Form5.Visible; + END; + +PROCEDURE TForm1.btn_extractcancelClick(Sender: TObject); + BEGIN + btn_extractcancel.Caption:='Cancel_'; + END; + +PROCEDURE TForm1.menu_exitClick(Sender: TObject); + BEGIN + Form1.Close; + END; + +PROCEDURE TForm1.menu_txmpreplaceClick(Sender: TObject); + BEGIN + Form7.Visible:=NOT Form7.Visible; + END; + +END. Index: /oup/releases/0.13a/Unit2_functions.pas =================================================================== --- /oup/releases/0.13a/Unit2_functions.pas (revision 21) +++ /oup/releases/0.13a/Unit2_functions.pas (revision 21) @@ -0,0 +1,206 @@ +UNIT Unit2_functions; +INTERFACE +USES Classes, SysUtils, StrUtils, Math, Unit3_data, Unit4_Exporters; + +FUNCTION LoadDatInfos(filename:String):Boolean; +FUNCTION LoadDatFile(fileid:LongWord):Tdata; +FUNCTION LoadDatFilePart(fileid,offset,size:LongWord; target:Pointer):Boolean; +FUNCTION LoadRawFilePart(address,size:LongWord; target:Pointer):Boolean; +FUNCTION FormatNumber(value:LongWord; width:Byte; leadingzeros:Char):String; +FUNCTION FormatFileSize(size:LongWord):String; +FUNCTION CreateHexString(data:Tdata; HexOnly:Boolean):String; +FUNCTION ExportFile(fileid:LongWord; convert:Boolean):Integer; +FUNCTION GetWinFileName(fileid:LongWord; substring:String):String; +FUNCTION GetExtractPath:String; + + + +IMPLEMENTATION + + +FUNCTION LoadDatInfos(filename:String):Boolean; + VAR i:LongWord; + dat_file:TFileStream; + BEGIN + Result:=True; + IF Length(filename)>0 THEN dat_file.Free; + dat_filename:=filename; + raw_filename:=MidStr(filename,1,Length(filename)-3)+'raw'; + dat_file:=TFileStream.Create(filename, fmOpenRead); + dat_file.Read(dat_header,SizeOf(dat_header)); + FOR i:=0 TO High(dat_header.Ident) DO + IF dat_header.Ident[i]<>header_ident1[i] THEN BEGIN + Result:=False; + Exit; + END; +{ FOR i:=0 TO High(dat_header.Ident2) DO + IF dat_header.Ident2[i]<>header_ident2[i] THEN BEGIN + Result:=False; + Exit; + END; +} + SetLength(dat_filesmap,dat_header.Files); + SetLength(dat_files,dat_header.Files); + FOR i:=0 TO dat_header.Files-1 DO dat_file.Read(dat_filesmap[i],SizeOf(dat_filesmap[i])); + FOR i:=0 TO dat_header.Files-1 DO BEGIN + dat_files[i].Extension:=dat_filesmap[i].Extension; + dat_files[i].Extension:=ReverseString(dat_files[i].Extension); + dat_files[i].Size:=dat_filesmap[i].FileSize; + dat_files[i].FileType:=dat_filesmap[i].FileType; + dat_files[i].DatAddr:=dat_filesmap[i].DataAddr-8+dat_header.DataAddr; + IF (dat_filesmap[i].FileType AND $01)=0 THEN BEGIN + dat_file.Seek(dat_filesmap[i].NameAddr+dat_header.NamesAddr,soFromBeginning); + SetLength(dat_files[i].Name,100); + dat_file.Read(dat_files[i].Name[1],100); + dat_files[i].Name:=MidStr(dat_files[i].Name,1+4,Pos(#0,dat_files[i].Name)-1-4); + END ELSE BEGIN + dat_files[i].Name:=''; + END; + dat_files[i].FileName:=FormatNumber(i,5,'0')+'-'+dat_files[i].Name+'.'+dat_files[i].Extension; + END; + dat_file.Seek($40+dat_header.Files*$14,soFromBeginning); + SetLength(dat_namedfilesmap,dat_header.NamedFiles); + FOR i:=0 TO dat_header.NamedFiles-1 DO dat_file.Read(dat_namedfilesmap[i],SizeOf(dat_namedfilesmap[i])); + + dat_file.Seek($40+dat_header.Files*$14+dat_header.NamedFiles*$8,soFromBeginning); + SetLength(dat_extensionsmap,dat_header.Extensions); + FOR i:=0 TO dat_header.Extensions-1 DO dat_file.Read(dat_extensionsmap[i],SizeOf(dat_extensionsmap[i])); + + dat_file.Free; + END; + + +FUNCTION LoadDatFile(fileid:LongWord):Tdata; + VAR dat_file:TFileStream; + BEGIN + dat_file:=TFileStream.Create(dat_filename, fmOpenRead); + dat_file.Seek(dat_files[fileid].DatAddr,soFromBeginning); + SetLength(Result,dat_files[fileid].Size); + dat_file.Read(Result[0],dat_files[fileid].Size); + dat_file.Free; + END; + + +FUNCTION LoadDatFilePart(fileid,offset,size:LongWord; target:Pointer):Boolean; + VAR dat_file:TFileStream; + BEGIN + dat_file:=TFileStream.Create(dat_filename, fmOpenRead); + Result:=True; + dat_file.Seek(dat_files[fileid].DatAddr+offset,soFromBeginning); + dat_file.Read(target^,size); + dat_file.Free; + END; + + +FUNCTION LoadRawFilePart(address,size:LongWord; target:Pointer):Boolean; + VAR + filestream:TFileStream; + BEGIN + Result:=True; + filestream:=TFileStream.Create(AnsiReplaceStr(dat_filename,'.dat','.raw'),fmOpenRead); + filestream.Seek(address,soFromBeginning); + filestream.Read(target^,size); + filestream.Free; + END; + + +FUNCTION FormatNumber(value:LongWord; width:Byte; leadingzeros:Char):String; + BEGIN + Result:=AnsiReplaceStr(Format('%'+IntToStr(width)+'u',[value]),' ',leadingzeros); + END; + + +FUNCTION FormatFileSize(size:LongWord):String; + BEGIN + IF size>=1024*1024*1024 THEN BEGIN + Result:=FloatToStrF(size/1024/1024/1024,ffFixed,5,1)+' GB'; + END ELSE BEGIN + IF size>=1024*1024 THEN BEGIN + Result:=FloatToStrF(size/1024/1024,ffFixed,5,1)+' MB'; + END ELSE BEGIN + IF size>=1024 THEN BEGIN + Result:=FloatToStrF(size/1024,ffFixed,5,1)+' KB'; + END ELSE BEGIN + Result:=IntToStr(size)+' B'; + END; + END; + END; + END; + + +FUNCTION CreateHexString(data:Tdata; HexOnly:Boolean):String; + VAR + string_build,ascii_version:String; + i:LongWord; + BEGIN + string_build:=''; + ascii_version:=''; + FOR i:=0 TO High(data) DO BEGIN + IF NOT HexOnly THEN + IF (i MOD 16)=0 THEN + string_build:=string_build+'0x'+IntToHex(i,6)+' '; + string_build:=string_build+IntToHex(data[i],2); + IF NOT HexOnly THEN BEGIN + IF data[i]>=32 THEN ascii_version:=ascii_version+Chr(data[i]) + ELSE ascii_version:=ascii_version+'.'; + IF ((i+1) MOD 2)=0 THEN string_build:=string_build+#32; + IF ((i+1) MOD 16)=0 THEN BEGIN + string_build:=string_build+#32+ascii_version+CrLf; + ascii_version:=''; + END; + END; + END; + Result:=string_build; + END; + + +FUNCTION ExportFile(fileid:LongWord; convert:Boolean):Integer; + VAR + i:Byte; + BEGIN + Result:=export_noerror; + + ExportDefFileHeader(fileid); + + IF (dat_files[fileid].FileType AND $02)=0 THEN BEGIN + ExportDatFile(fileid); + + FOR i:=1 TO Length(ExportHandlers)+1 DO BEGIN + IF i<=Length(ExportHandlers) THEN BEGIN + IF ExportHandlers[i].Ext=dat_files[fileid].Extension THEN BEGIN + IF ExportHandlers[i].needed THEN BEGIN + CASE ExportHandlers[i].Handler(fileid,convert) OF + 0: Result:=0; + ELSE + Result:=export_handlererror; + END; + END; + Break; + END; + END ELSE BEGIN + Result:=export_nohandler; + END; + END; + END; + END; + + +FUNCTION GetWinFileName(fileid:LongWord; substring:String):String; + VAR + name:String; + BEGIN + name:=dat_files[fileid].Name; + name:=AnsiReplaceStr(name,'\','__'); + name:=AnsiReplaceStr(name,'/','__'); + name:=AnsiReplaceStr(name,'>','__'); + name:=AnsiReplaceStr(name,'<','__'); + Result:=FormatNumber(fileid,5,'0')+'-'+name+'.'+substring+'.'+dat_files[fileid].Extension; + END; + +FUNCTION GetExtractPath:String; + BEGIN + Result:=ExtractFilePath(dat_filename)+'\extracted_'+ExtractFileName(dat_filename); + END; + + +END. Index: /oup/releases/0.13a/Unit3_data.pas =================================================================== --- /oup/releases/0.13a/Unit3_data.pas (revision 21) +++ /oup/releases/0.13a/Unit3_data.pas (revision 21) @@ -0,0 +1,84 @@ +UNIT Unit3_data; +INTERFACE +USES Classes; + +CONST + version:String='v0.13a'; + CrLf:String[2]=#13+#10; + +TYPE + Tdata=Array OF Byte; + Theader=PACKED RECORD + Ident:Array[0..$13] OF Byte; + Files:LongWord; + NamedFiles:LongWord; + Extensions:LongWord; + DataAddr:LongWord; + DataSize:LongWord; + NamesAddr:LongWord; + NamesSize:LongWord; + Ident2:Array[0..$F] OF Byte; + END; + Tfilesmap=Array OF PACKED RECORD + Extension:Array[0..$3] OF Char; + DataAddr:LongWord; + NameAddr:LongWord; + FileSize:LongWord; + FileType:LongWord; + END; + Tfiles=Array OF PACKED RECORD + FileName:String; + Extension:String[4]; + Name:String; + Size:LongWord; + FileType:LongWord; + DatAddr:LongWord; + END; + + Tnamedfilesmap=Array OF PACKED RECORD + FileNumber:LongWord; + blubb:LongWord; + END; + Textensionsmap=Array OF PACKED RECORD + Ident:Array[0..$7] OF Byte; + Extension:Array[0..$3] OF Char; + ExtCount:LongWord; + END; + + TAppSettings=RECORD + DatPath:String[250]; + ExtractPath:String[250]; + END; + + TExportHandlers=RECORD + Ext:String[4]; + needed:Boolean; + Handler:Function(fileid:LongWord; convert:Boolean):Integer; + END; + +VAR + dat_filename:String=''; + raw_filename:String=''; + dat_header:Theader; + dat_filesmap:Tfilesmap; + dat_files:Tfiles; + dat_namedfilesmap:Tnamedfilesmap; + dat_extensionsmap:Textensionsmap; + AppSettings:TAppSettings; + AppSettingsFile:File OF TAppSettings; + +CONST + header_ident1:Array[0..$13] OF Byte= + ($1F,$27,$DC,$33,$DF,$BC,$03,$00,$31,$33,$52,$56,$40,$00,$14,$00,$10,$00,$08,$00); + header_ident2:Array[0..$F] OF Byte= + ($99,$CF,$40,$00,$90,$4F,$63,$00,$F4,$55,$5F,$00,$90,$4F,$63,$00); + + export_noerror:Integer=0; + export_nohandler:Integer=1; + export_handlererror:Integer=2; + export_error:Integer=3; + +IMPLEMENTATION + +END. + Index: /oup/releases/0.13a/Unit4_Exporters.pas =================================================================== --- /oup/releases/0.13a/Unit4_Exporters.pas (revision 21) +++ /oup/releases/0.13a/Unit4_Exporters.pas (revision 21) @@ -0,0 +1,180 @@ +UNIT Unit4_Exporters; +INTERFACE +USES Classes, StrUtils, SysUtils, Math, Unit3_data, Unit6_imgfuncs; + +PROCEDURE ExportDefLine(fileid:LongWord; line:String; create:Boolean); +PROCEDURE ExportDefFileHeader(fileid:LongWord); +PROCEDURE ExportDatFile(fileid:LongWord); + +FUNCTION ExportTRAC(fileid:LongWord; convert:Boolean):Integer; +FUNCTION ExportTXAN(fileid:LongWord; convert:Boolean):Integer; +FUNCTION ExportTXMB(fileid:LongWord; convert:Boolean):Integer; +FUNCTION ExportTXMP(fileid:LongWord; convert:Boolean):Integer; +VAR + ExportHandlers:Array[1..5] OF TExportHandlers=( + (Ext:'ABNA'; needed:False), + //(Ext:'AGDB'; needed:False), + (Ext:'TRAC'; needed:True; Handler:ExportTRAC), + (Ext:'TXAN'; needed:True; Handler:ExportTXAN), + (Ext:'TXMB'; needed:True; Handler:ExportTXMB), + (Ext:'TXMP'; needed:True; Handler:ExportTXMP) + ); + + + +IMPLEMENTATION +USES Unit2_functions; + +PROCEDURE ExportDefLine(fileid:LongWord; line:String; create:Boolean); + VAR + filestream:TFileStream; + data:Tdata; + i:LongWord; + BEGIN + SetLength(data,Length(line)+2); + FOR i:=1 TO Length(line) DO + data[i-1]:=Ord(line[i]); + data[Length(line)]:=13; + data[Length(line)+1]:=10; + + IF create THEN + filestream:=TFileStream.Create(GetExtractPath+'\'+GetWinFileName(fileid,'_DEF_'),fmCreate) + ELSE BEGIN + filestream:=TFileStream.Create(GetExtractPath+'\'+GetWinFileName(fileid,'_DEF_'),fmOpenWrite); + filestream.Seek(0,soFromEnd); + END; + filestream.Write(data[0],Length(data)); + filestream.Free; + END; + +PROCEDURE ExportDefFileHeader(fileid:LongWord); + BEGIN + IF NOT DirectoryExists(GetExtractPath) THEN + CreateDir(GetExtractPath); + WITH dat_files[fileid] DO + ExportDefLine(fileid,FormatNumber(fileid,5,'0')+':'+Name+':'+Extension+':'+IntToHex(Size,8)+':'+IntToHex(FileType,8),True); + END; + +PROCEDURE ExportDatFile(fileid:LongWord); + VAR + filestream:TFileStream; + data:Tdata; + BEGIN + data:=LoadDatFile(fileid); + filestream:=TFileStream.Create(GetExtractPath+'\'+GetWinFileName(fileid,'_DAT_'),fmCreate); + filestream.Write(data[0],Length(data)); + filestream.Free; + END; + + +FUNCTION ExportTRAC; + VAR + link:LongWord; + linkcount:Word; + i:LongWord; + BEGIN + Result:=export_noerror; + + LoadDatFilePart(fileid,$18,SizeOf(link),@link); + link:=link DIV 256; + ExportDefLine(fileid,FormatNumber(0,4,'0')+':LINKtoTRAC:'+FormatNumber(link,5,'0')+':'+dat_files[link].Name+':'+dat_files[link].Extension,False); + + LoadDatFilePart(fileid,$1E,SizeOf(linkcount),@linkcount); + ExportDefLine(fileid,'TRAMLINKS:'+FormatNumber(linkcount,4,'0'),False); + FOR i:=1 TO linkcount DO BEGIN + LoadDatFilePart(fileid,$20+(i-1)*12+8,SizeOf(link),@link); + link:=link DIV 256; + ExportDefLine(fileid,FormatNumber(i,4,'0')+':LINKtoTRAM:'+FormatNumber(link,5,'0')+':'+dat_files[link].Name+':'+dat_files[link].Extension,False); + END; + END; + +FUNCTION ExportTXAN; + VAR + loop_speed,unknown:Word; + linkcount:LongWord; + link:LongWord; + i:Byte; + BEGIN + Result:=export_noerror; + + LoadDatFilePart(fileid,$14,SizeOf(loop_speed),@loop_speed); + LoadDatFilePart(fileid,$16,SizeOf(unknown),@unknown); + ExportDefLine(fileid,'LOOPSPEED:'+FormatNumber(loop_speed,2,'0'),False); + ExportDefLine(fileid,'UNKNOWN:'+FormatNumber(unknown,2,'0'),False); + + LoadDatFilePart(fileid,$1C,SizeOf(linkcount),@linkcount); + ExportDefLine(fileid,'TXMPLINKS:'+FormatNumber(linkcount,4,'0'),False); + FOR i:=0 TO linkcount-1 DO BEGIN + LoadDatFilePart(fileid,$20+i*4,SizeOf(link),@link); + link:=link DIV 256; + IF link=0 THEN link:=fileid-1; + ExportDefLine(fileid,FormatNumber(i,4,'0')+':LINKtoTXMP:'+FormatNumber(link,5,'0')+':'+dat_files[link].Name+':'+dat_files[link].Extension,False); + END; + END; + +FUNCTION ExportTXMB; + VAR + filestream:TFileStream; + subfile:Byte; + linkcount:LongWord; + link:LongWord; + width,height:Word; + cols,rows:Word; + i:Byte; + img:TImgPackage; + data:Tdata; + BEGIN + Result:=export_noerror; + subfile:=1; + + LoadDatFilePart(fileid,$10,SizeOf(width),@width); + LoadDatFilePart(fileid,$12,SizeOf(height),@height); + LoadDatFilePart(fileid,$18,SizeOf(cols),@cols); + LoadDatFilePart(fileid,$1A,SizeOf(rows),@rows); + ExportDefLine(fileid,'WIDTH:'+FormatNumber(width,4,'0'),False); + ExportDefLine(fileid,'HEIGHT:'+FormatNumber(height,4,'0'),False); + ExportDefLine(fileid,'COLS:'+FormatNumber(cols,2,'0'),False); + ExportDefLine(fileid,'ROWS:'+FormatNumber(rows,2,'0'),False); + + LoadDatFilePart(fileid,$1C,SizeOf(linkcount),@linkcount); + ExportDefLine(fileid,'TXMPLINKS:'+FormatNumber(linkcount,4,'0'),False); + FOR i:=0 TO linkcount-1 DO BEGIN + LoadDatFilePart(fileid,$20+i*4,SizeOf(link),@link); + link:=link DIV 256; + IF link=0 THEN link:=fileid-1; + ExportDefLine(fileid,FormatNumber(i,4,'0')+':LINKtoTXMP:'+FormatNumber(link,5,'0')+':'+dat_files[link].Name+':'+dat_files[link].Extension,False); + END; + + IF convert THEN BEGIN + img:=LoadTXMBconnected(fileid); + data:=ImgdataToBmp(img.imgx,img.imgy,img.imgdepth,img.storetype,img.imgdata); + filestream:=TFileStream.Create(GetExtractPath+'\'+GetWinFileName(fileid,FormatNumber(subfile,2,'0')+'-ImgData')+'.bmp',fmCreate); + filestream.Write(data[0],Length(data)); + filestream.Free; + END; + END; + +FUNCTION ExportTXMP; + VAR + filestream:TFileStream; + subfile:Byte; + img:TImgPackage; + BEGIN + Result:=export_noerror; + subfile:=1; + + img:=LoadImgData(fileid); + + filestream:=TFileStream.Create(GetExtractPath+'\'+GetWinFileName(fileid,FormatNumber(subfile,2,'0')+'-ImgData'),fmCreate); + filestream.Write(img.imgdata[0],Length(img.imgdata)); + filestream.Free; + + IF convert THEN BEGIN + img.imgdata:=ImgdataToBMP(img.imgx,img.imgy,img.imgdepth,img.storetype,img.imgdata); + filestream:=TFileStream.Create(GetExtractPath+'\'+GetWinFileName(fileid,FormatNumber(subfile,2,'0')+'-ImgData')+'.bmp',fmCreate); + filestream.Write(img.imgdata[0],Length(img.imgdata)); + filestream.Free; + END; + END; + +END. Index: /oup/releases/0.13a/Unit5_preview.dfm =================================================================== --- /oup/releases/0.13a/Unit5_preview.dfm (revision 21) +++ /oup/releases/0.13a/Unit5_preview.dfm (revision 21) @@ -0,0 +1,74 @@ +object Form5: TForm5 + Left = 0 + Top = 0 + Width = 435 + Height = 348 + BorderStyle = bsSizeToolWin + Caption = 'Preview' + Color = clBtnFace + Font.Charset = DEFAULT_CHARSET + Font.Color = clWindowText + Font.Height = -11 + Font.Name = 'Tahoma' + Font.Style = [] + FormStyle = fsStayOnTop + OldCreateOrder = False + OnCloseQuery = FormCloseQuery + OnCreate = FormCreate + OnResize = FormResize + PixelsPerInch = 96 + TextHeight = 13 + object img: TImage + Left = 0 + Top = 20 + Width = 427 + Height = 304 + Align = alClient + end + object panel_buttons: TPanel + Left = 0 + Top = 0 + Width = 427 + Height = 20 + Align = alTop + BevelOuter = bvNone + TabOrder = 0 + Visible = False + OnResize = panel_buttonsResize + object btn_dec: TButton + Left = 0 + Top = 0 + Width = 20 + Height = 20 + Caption = '-' + Enabled = False + TabOrder = 0 + OnClick = btn_decClick + end + object btn_startstop: TButton + Left = 21 + Top = 0 + Width = 80 + Height = 20 + Caption = 'Stop automatic' + TabOrder = 1 + OnClick = btn_startstopClick + end + object btn_inc: TButton + Left = 102 + Top = 0 + Width = 20 + Height = 20 + Caption = '+' + Enabled = False + TabOrder = 2 + OnClick = btn_incClick + end + end + object timer: TTimer + Enabled = False + OnTimer = timerTimer + Left = 72 + Top = 48 + end +end Index: /oup/releases/0.13a/Unit5_preview.pas =================================================================== --- /oup/releases/0.13a/Unit5_preview.pas (revision 21) +++ /oup/releases/0.13a/Unit5_preview.pas (revision 21) @@ -0,0 +1,189 @@ +UNIT Unit5_preview; +INTERFACE +USES + Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, + Dialogs, Math, ExtCtrls, Unit2_functions, Unit3_data, Unit4_exporters, Unit6_imgfuncs, + StdCtrls; + +TYPE + TForm5 = Class(TForm) + img: TImage; + timer: TTimer; + panel_buttons: TPanel; + btn_dec: TButton; + btn_startstop: TButton; + btn_inc: TButton; + PROCEDURE btn_incClick(Sender: TObject); + PROCEDURE btn_decClick(Sender: TObject); + PROCEDURE FormResize(Sender: TObject); + PROCEDURE btn_startstopClick(Sender: TObject); + PROCEDURE panel_buttonsResize(Sender: TObject); + PROCEDURE timerTimer(Sender: TObject); + PROCEDURE FormCreate(Sender: TObject); + PROCEDURE FormCloseQuery(Sender: TObject; var CanClose: Boolean); + PROCEDURE ShowPreview(fileid:LongWord); + PRIVATE + PUBLIC + END; + +VAR + Form5: TForm5; + +IMPLEMENTATION +{$R *.dfm} +USES Unit1_main; +VAR + memstreams:Array OF TMemoryStream; + actualimg:Byte; + _fileid:LongWord; + +PROCEDURE PreviewTXMB; + VAR + data:Tdata; + img:TImgPackage; + BEGIN + SetLength(memstreams,1); + img:=LoadTXMBconnected(_fileid); + data:=ImgdataToBmp(img.imgx,img.imgy,img.imgdepth,img.storetype,img.imgdata); + + memstreams[0].Clear; + memstreams[0].Write(data[0],Length(data)); + memstreams[0].Seek(0,soFromBeginning); + + Form5.img.Picture.Bitmap.LoadFromStream(memstreams[0]); + END; + +PROCEDURE PreviewTXMP; + VAR + data:Tdata; + img:TImgPackage; + BEGIN + { + tempdata:=ResizeImage(imgx,imgy,imgdepth,tempdata); + imgx:=imgx DIV 2; + imgy:=imgy DIV 2; + datasize:=datasize DIV 4; + } + SetLength(memstreams,1); + img:=LoadImgData(_fileid); + data:=ImgdataToBmp(img.imgx,img.imgy,img.imgdepth,img.storetype,img.imgdata); + + memstreams[0].Clear; + memstreams[0].Write(data[0],Length(data)); + memstreams[0].Seek(0,soFromBeginning); + + Form5.img.Picture.Bitmap.LoadFromStream(memstreams[0]); + END; + +PROCEDURE PreviewTXAN; + VAR + loop_speed:Word; + linkcount:LongWord; + link:LongWord; + i:Byte; + data:Tdata; + img:TImgPackage; + BEGIN + LoadDatFilePart(_fileid,$14,SizeOf(loop_speed),@loop_speed); + LoadDatFilePart(_fileid,$1C,SizeOf(linkcount),@linkcount); + SetLength(memstreams,linkcount); + FOR i:=0 TO linkcount-1 DO BEGIN + LoadDatFilePart(_fileid,$20+i*4,SizeOf(link),@link); + link:=link DIV 256; + IF link=0 THEN link:=_fileid-1; + memstreams[i]:=TMemoryStream.Create; + img:=LoadImgData(link); + data:=ImgdataToBmp(img.imgx,img.imgy,img.imgdepth,img.storetype,img.imgdata); + memstreams[i].Clear; + memstreams[i].Write(data[0],Length(data)); + memstreams[i].Seek(0,soFromBeginning); + END; + actualimg:=254; + Form5.timer.Interval:=Floor(loop_speed*(1/60)*1000); + Form5.timer.Enabled:=False; + Form5.btn_startstopClick(Form5); + Form5.panel_buttons.Visible:=True; + END; + +PROCEDURE TForm5.ShowPreview(fileid:LongWord); + BEGIN + _fileid:=fileid; + Form5.timer.Enabled:=False; + Form5.panel_buttons.Visible:=False; + Form5.Caption:='Preview '+dat_files[_fileid].FileName; + IF dat_files[fileid].Extension='TXAN' THEN PreviewTXAN; + IF dat_files[fileid].Extension='TXMB' THEN PreviewTXMB; + IF dat_files[fileid].Extension='TXMP' THEN PreviewTXMP; + END; + +PROCEDURE TForm5.FormCloseQuery(Sender: TObject; var CanClose: Boolean); + BEGIN + CanClose:=False; + Form5.Visible:=False; + END; + +PROCEDURE TForm5.FormCreate(Sender: TObject); + BEGIN + SetLength(memstreams,1); + memstreams[0]:=TMemoryStream.Create; + Form5.Width:=170; + Form5.Height:=200; + END; + +PROCEDURE TForm5.timerTimer(Sender: TObject); + BEGIN + Inc(actualimg); + IF actualimg>=Length(memstreams) THEN actualimg:=0; + Form5.img.Picture.Bitmap.LoadFromStream(memstreams[actualimg]); + memstreams[actualimg].Seek(0,soFromBeginning); + Form5.Caption:='Preview '+dat_files[_fileid].FileName+' ('+IntToStr(actualimg+1)+'/'+IntToStr(Length(memstreams))+')'; + END; + +PROCEDURE TForm5.panel_buttonsResize(Sender: TObject); + BEGIN + btn_startstop.Width:=panel_buttons.Width-45; + btn_inc.Left:=panel_buttons.Width-23; + END; + +PROCEDURE TForm5.btn_startstopClick(Sender: TObject); + BEGIN + Form5.timer.Enabled:=NOT Form5.timer.Enabled; + Form5.btn_dec.Enabled:=NOT Form5.timer.Enabled; + Form5.btn_inc.Enabled:=NOT Form5.timer.Enabled; + IF Form5.timer.Enabled THEN + Form5.btn_startstop.Caption:='Stop automatic' + ELSE + Form5.btn_startstop.Caption:='Start automatic'; + END; + +PROCEDURE TForm5.FormResize(Sender: TObject); + BEGIN + IF Form5.Width>=150 THEN BEGIN + END ELSE Form5.Width:=150; + IF Form5.Height>=150 THEN BEGIN + END ELSE Form5.Height:=150; + END; + +PROCEDURE TForm5.btn_decClick(Sender: TObject); + BEGIN + IF actualimg>0 THEN + Dec(actualimg) + ELSE + actualimg:=High(memstreams); + Form5.Caption:='Preview '+dat_files[_fileid].FileName+' ('+IntToStr(actualimg+1)+'/'+IntToStr(Length(memstreams))+')'; + Form5.img.Picture.Bitmap.LoadFromStream(memstreams[actualimg]); + memstreams[actualimg].Seek(0,soFromBeginning); + END; + +PROCEDURE TForm5.btn_incClick(Sender: TObject); + BEGIN + IF actualimg0) THEN BEGIN + Inc(row_orig); + IF (row_orig MOD 2)=0 THEN BEGIN + Inc(row); + col:=0; + END; + END; + IF (row_orig MOD 2)=0 THEN BEGIN + IF (i MOD 2)=0 THEN BEGIN + FOR j:=0 TO (imgdepth DIV 8)-1 DO + temparray[((row*(oldx DIV 2))+col)*(imgdepth DIV 8)+j]:=data[i*2+j]; + Inc(col); + END; + END; + END; + Result:=temparray; + END; + + +FUNCTION RevertImage(imgx,imgy,imgdepth:LongWord; imgdata:Tdata):Tdata; + VAR + x,y,i:LongWord; + BEGIN + SetLength(Result,imgx*imgy*(imgdepth DIV 8)); + FOR y:=0 TO imgy-1 DO + FOR x:=0 TO imgx-1 DO + FOR i:=0 TO (imgdepth DIV 8)-1 DO + Result[((imgx*(imgy-1-y)+x)*(imgdepth DIV 8))+i]:= + imgdata[(imgx*y+x)*(imgdepth DIV 8)+i]; + END; + + +FUNCTION DecompressImage(imgx,imgy:LongWord; imgdata:Tdata):Tdata; + TYPE + Tcolor=RECORD + RGBb:Byte; + RGBg:Byte; + RGBr:Byte; + RGBa:Byte; + END; + VAR + i,j,x,y:LongWord; + color:Array[1..4] OF Tcolor; + pixel:Array[1..16] OF Byte; + BEGIN + x:=0; + y:=0; + SetLength(Result,imgx*imgy*4); + FOR i:=0 TO ((imgx*imgy) DIV 16)-1 DO BEGIN + Color[1].RGBb:=Floor(((imgdata[(i*8)+0]+imgdata[(i*8)+1]*256) AND $001F) / $001F * 255); + Color[1].RGBg:=Floor(((imgdata[(i*8)+0]+imgdata[(i*8)+1]*256) AND $07E0) / $07E0 * 255); + Color[1].RGBr:=Floor(((imgdata[(i*8)+0]+imgdata[(i*8)+1]*256) AND $F800) / $F800 * 255); + Color[1].RGBa:=255; + Color[2].RGBb:=Floor(((imgdata[(i*8)+2]+imgdata[(i*8)+3]*256) AND $001F) / $001F * 255); + Color[2].RGBg:=Floor(((imgdata[(i*8)+2]+imgdata[(i*8)+3]*256) AND $07E0) / $07E0 * 255); + Color[2].RGBr:=Floor(((imgdata[(i*8)+2]+imgdata[(i*8)+3]*256) AND $F800) / $F800 * 255); + Color[2].RGBa:=255; + Color[3].RGBb:=Floor( Color[1].RGBb/3*2 + Color[2].RGBb/3 ); + Color[3].RGBg:=Floor( Color[1].RGBg/3*2 + Color[2].RGBg/3 ); + Color[3].RGBr:=Floor( Color[1].RGBr/3*2 + Color[2].RGBr/3 ); + Color[3].RGBa:=255; + Color[4].RGBb:=Floor( Color[1].RGBb/3 + Color[2].RGBb/3*2 ); + Color[4].RGBg:=Floor( Color[1].RGBg/3 + Color[2].RGBg/3*2 ); + Color[4].RGBr:=Floor( Color[1].RGBr/3 + Color[2].RGBr/3*2 ); + Color[4].RGBa:=255; + Pixel[1]:=Floor( (imgdata[(i*8)+4] AND $C0) / $40 + 1 ); + Pixel[2]:=Floor( (imgdata[(i*8)+4] AND $30) / $10 + 1 ); + Pixel[3]:=Floor( (imgdata[(i*8)+4] AND $0C) / $04 + 1 ); + Pixel[4]:=Floor( (imgdata[(i*8)+4] AND $03) + 1 ); + Pixel[5]:=Floor( (imgdata[(i*8)+5] AND $C0) / $40 + 1 ); + Pixel[6]:=Floor( (imgdata[(i*8)+5] AND $30) / $10 + 1 ); + Pixel[7]:=Floor( (imgdata[(i*8)+5] AND $0C) / $04 + 1 ); + Pixel[8]:=Floor( (imgdata[(i*8)+5] AND $03) + 1 ); + Pixel[9]:=Floor( (imgdata[(i*8)+6] AND $C0) / $40 + 1 ); + Pixel[10]:=Floor( (imgdata[(i*8)+6] AND $30) / $10 + 1 ); + Pixel[11]:=Floor( (imgdata[(i*8)+6] AND $0C) / $04 + 1 ); + Pixel[12]:=Floor( (imgdata[(i*8)+6] AND $03) + 1 ); + Pixel[13]:=Floor( (imgdata[(i*8)+7] AND $C0) / $40 + 1 ); + Pixel[14]:=Floor( (imgdata[(i*8)+7] AND $30) / $10 + 1 ); + Pixel[15]:=Floor( (imgdata[(i*8)+7] AND $0C) / $04 + 1 ); + Pixel[16]:=Floor( (imgdata[(i*8)+7] AND $03) + 1 ); + FOR j:=0 TO 3 DO BEGIN + Result[((y+3)*imgx+x+j)*3+0]:=Color[Pixel[16-j]].RGBb; + Result[((y+3)*imgx+x+j)*3+1]:=Color[Pixel[16-j]].RGBg; + Result[((y+3)*imgx+x+j)*3+2]:=Color[Pixel[16-j]].RGBr; + END; + FOR j:=0 TO 3 DO BEGIN + Result[((y+2)*imgx+x+j)*3+0]:=Color[Pixel[12-j]].RGBb; + Result[((y+2)*imgx+x+j)*3+1]:=Color[Pixel[12-j]].RGBg; + Result[((y+2)*imgx+x+j)*3+2]:=Color[Pixel[12-j]].RGBr; + END; + FOR j:=0 TO 3 DO BEGIN + Result[((y+1)*imgx+x+j)*3+0]:=Color[Pixel[8-j]].RGBb; + Result[((y+1)*imgx+x+j)*3+1]:=Color[Pixel[8-j]].RGBg; + Result[((y+1)*imgx+x+j)*3+2]:=Color[Pixel[8-j]].RGBr; + END; + FOR j:=0 TO 3 DO BEGIN + Result[((y+0)*imgx+x+j)*3+0]:=Color[Pixel[4-j]].RGBb; + Result[((y+0)*imgx+x+j)*3+1]:=Color[Pixel[4-j]].RGBg; + Result[((y+0)*imgx+x+j)*3+2]:=Color[Pixel[4-j]].RGBr; + END; + x:=x+4; + IF x=imgx THEN BEGIN + y:=y+4; + x:=0; + END; + END; + END; + + +FUNCTION ImgdataToBmp(imgx,imgy,imgdepth,storetype:LongWord; imgdata:Tdata):Tdata; + CONST BMPheader:Array[0..53] OF Byte= + ($42,$4D,0,0,0,0,0,0,0,0,54,0,0,0, + 40,0,0,0,0,0,0,0,0,0,0,0,1,0,$18,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0); + VAR + i,x,y:LongWord; + BEGIN + CASE storetype OF + 0: BEGIN + SetLength(Result,imgx*imgy*3); + FOR y:=0 TO imgy-1 DO BEGIN + FOR x:=0 TO imgx-1 DO BEGIN + Result[((imgx*y+x)*3)+0]:=Floor( ( (imgdata[(imgx*y+x)*2]+imgdata[(imgx*y+x)*2+1]*256) AND $000F ) / $000F * 255); + Result[((imgx*y+x)*3)+1]:=Floor( ( (imgdata[(imgx*y+x)*2]+imgdata[(imgx*y+x)*2+1]*256) AND $00F0 ) / $00F0 * 255); + Result[((imgx*y+x)*3)+2]:=Floor( ( (imgdata[(imgx*y+x)*2]+imgdata[(imgx*y+x)*2+1]*256) AND $0F00 ) / $0F00 * 255); + END; + END; + END; + 1,2,8: BEGIN + SetLength(Result,imgx*imgy*3); + FOR y:=0 TO imgy-1 DO BEGIN + FOR x:=0 TO imgx-1 DO BEGIN + Result[((imgx*y+x)*3)+0]:=Floor( ( (imgdata[(imgx*y+x)*2]+imgdata[(imgx*y+x)*2+1]*256) AND $001F ) / $001F * 255); + Result[((imgx*y+x)*3)+1]:=Floor( ( (imgdata[(imgx*y+x)*2]+imgdata[(imgx*y+x)*2+1]*256) AND $03E0 ) / $03E0 * 255); + Result[((imgx*y+x)*3)+2]:=Floor( ( (imgdata[(imgx*y+x)*2]+imgdata[(imgx*y+x)*2+1]*256) AND $7C00 ) / $7C00 * 255); + END; + END; + END; + 9: BEGIN + Result:=DecompressImage(imgx,imgy,imgdata); + END; + END; + Result:=RevertImage(imgx,imgy,24,Result); + SetLength(Result,imgx*imgy*3+54); + FOR i:=High(Result)-54 DOWNTO 0 DO Result[i+54]:=Result[i]; + + FOR i:=0 TO High(BMPheader) DO Result[i]:=BMPheader[i]; + Result[2]:=((imgx*imgy*3+54) AND $000000FF); + Result[3]:=((imgx*imgy*3+54) AND $0000FF00) DIV $100; + Result[4]:=((imgx*imgy*3+54) AND $00FF0000) DIV $10000; + Result[5]:=((imgx*imgy*3+54) AND $FF000000) DIV $1000000; + Result[18]:=(imgx AND $000000FF) DIV $1; + Result[19]:=(imgx AND $0000FF00) DIV $100; + Result[20]:=(imgx AND $00FF0000) DIV $10000; + Result[21]:=(imgx AND $FF000000) DIV $1000000; + Result[22]:=(imgy AND $000000FF) DIV $1; + Result[23]:=(imgy AND $0000FF00) DIV $100; + Result[24]:=(imgy AND $00FF0000) DIV $10000; + Result[25]:=(imgy AND $FF000000) DIV $1000000; + Result[34]:=((imgx*imgy*3) AND $000000FF) DIV $1; + Result[35]:=((imgx*imgy*3) AND $0000FF00) DIV $100; + Result[36]:=((imgx*imgy*3) AND $00FF0000) DIV $10000; + Result[37]:=((imgx*imgy*3) AND $FF000000) DIV $1000000; + END; + +FUNCTION BmpToImgdata(bmpdata:Tdata):TImgPackage; + VAR + x,y:LongWord; + r24,g24,b24:Word; + r16,g16,b16:Word; + gesamt:Word; + BEGIN + Result.imgdepth:=0; + IF NOT((bmpdata[00]=$42) AND (bmpdata[01]=$4D)) THEN BEGIN + ShowMessage('Not a standard 24bit bitmap'); + Exit; + END; + IF NOT(bmpdata[10]=54) THEN BEGIN + ShowMessage('Imagedata has to start at 0x54'); + Exit; + END; + IF NOT(bmpdata[14]=40) THEN BEGIN + ShowMessage('Second bitmap header has to have 40 bytes'); + Exit; + END; + IF NOT(bmpdata[28]=24) THEN BEGIN + ShowMessage('Bitmap has to have 24bits'); + Exit; + END; + IF NOT(bmpdata[30]=0) THEN BEGIN + ShowMessage('Bitmap has to be uncompressed'); + Exit; + END; + Result.imgx:=bmpdata[18]+bmpdata[19]*256+bmpdata[20]*256*256+bmpdata[21]*256*256*256; + Result.imgy:=bmpdata[22]+bmpdata[23]*256+bmpdata[24]*256*256+bmpdata[25]*256*256*256; + Result.imgdepth:=16; + Result.storetype:=1; + + SetLength(Result.imgdata,Result.imgx*Result.imgy*2); + FOR y:=0 TO Result.imgy-1 DO BEGIN + FOR x:=0 TO Result.imgx-1 DO BEGIN + r24:=bmpdata[54+(Result.imgx*y+x)*3+0]; + g24:=bmpdata[54+(Result.imgx*y+x)*3+1]; + b24:=bmpdata[54+(Result.imgx*y+x)*3+2]; + r16:=(Ceil(r24*$001F/255)) AND $001F; + g16:=(Ceil(g24*$03E0/255)) AND $03E0; + b16:=(Ceil(b24*$7C00/255)) AND $7C00; + gesamt:=r16+g16+b16; + Result.imgdata[((Result.imgx*y+x)*2)+0]:=gesamt AND $00FF; + Result.imgdata[((Result.imgx*y+x)*2)+1]:=(gesamt AND $FF00) DIV 256; + END; + END; + + Result.imgdata:=RevertImage(Result.imgx,Result.imgy,Result.imgdepth,Result.imgdata); + END; + +FUNCTION LoadTXMBconnected(fileid:LongWord):TImgPackage; + VAR + i,x,y,x2,y2,pixelid,imgid:LongWord; + rows,cols:Word; + linkcount:LongWord; + link:LongWord; + single_image:TImgPackage; + images_decoded:Array OF TImgPackage; + x_start,y_start:LongWord; + BEGIN + LoadDatFilePart(fileid,$10,SizeOf(Result.imgx),@Result.imgx); + LoadDatFilePart(fileid,$12,SizeOf(Result.imgy),@Result.imgy); + LoadDatFilePart(fileid,$18,SizeOf(cols),@cols); + LoadDatFilePart(fileid,$1A,SizeOf(rows),@rows); + LoadDatFilePart(fileid,$1C,SizeOf(linkcount),@linkcount); + SetLength(images_decoded,linkcount); + FOR i:=0 TO linkcount-1 DO BEGIN + LoadDatFilePart(fileid,$20+i*4,SizeOf(link),@link); + link:=link DIV 256; + single_image:=LoadImgData(link); + images_decoded[i]:=BmpToImgdata(ImgdataToBmp(single_image.imgx,single_image.imgy,single_image.imgdepth,single_image.storetype,single_image.imgdata)); + END; + SetLength(Result.imgdata,Result.imgx*Result.imgy*2); + FOR y:=0 TO rows-1 DO BEGIN + FOR x:=0 TO cols-1 DO BEGIN + imgid:=y*cols+x; + x_start:=0; + y_start:=0; + FOR i:=0 TO x DO IF i=400 THEN BEGIN + END ELSE Form7.Width:=400; + IF Form7.Height>=350 THEN BEGIN + END ELSE Form7.Height:=350; + END; + +PROCEDURE TForm7.list_txmpClick(Sender: TObject); + VAR + id:LongWord; + data:Tdata; + img:TImgPackage; + mem:TMemoryStream; + fadingbyte,depthbyte:Byte; + BEGIN + id:=StrToInt(MidStr(list_txmp.Items.Strings[list_txmp.ItemIndex],1,5)); + + LoadDatFilePart(id,$88,SizeOf(fadingbyte),@fadingbyte); + LoadDatFilePart(id,$89,SizeOf(depthbyte),@depthbyte); + Form7.check_fading.Checked:=(fadingbyte AND $01)>0; + Form7.check_transparency.Checked:=(depthbyte AND $04)>0; + + img:=LoadImgData(id); + data:=ImgdataToBmp(img.imgx,img.imgy,img.imgdepth,img.storetype,img.imgdata); + + mem:=TMemoryStream.Create; + mem.Write(data[0],Length(data)); + mem.Seek(0,soFromBeginning); + Form7.image_txmppreview.Picture.Bitmap.LoadFromStream(mem); + mem.Free; + + Form7.group_bmpselect.Enabled:=True; + END; + +PROCEDURE TForm7.btn_loadClick(Sender: TObject); + VAR + bmpfile:TFileStream; + mem:TMemoryStream; + BEGIN + IF opend.Execute THEN BEGIN + bmpfile:=TFileStream.Create(opend.FileName, fmOpenRead); + SetLength(actual_bmpdata,bmpfile.Size); + bmpfile.Read(actual_bmpdata[0],bmpfile.Size); + bmpfile.Free; + + mem:=TMemoryStream.Create; + mem.Write(actual_bmpdata[0],Length(actual_bmpdata)); + mem.Seek(0,soFromBeginning); + Form7.image_bmppreview.Picture.Bitmap.LoadFromStream(mem); + mem.Free; + + Form7.group_options.Enabled:=True; + END; + END; + +PROCEDURE TForm7.btn_replaceClick(Sender: TObject); + VAR + id:LongWord; + imgpkg:TImgPackage; + rawfile:TFileStream; + datfile:TFileStream; + dataddr:LongWord; + old_rawaddr,new_rawaddr:LongWord; + oldwidth,oldheight:Word; + oldstore,olddepth,oldfading:Byte; + oldsize:LongWord; + newsize:LongWord; + datword,datbyte:Word; + BEGIN + IF Form7.list_txmp.ItemIndex>=0 THEN BEGIN + imgpkg:=BmpToImgdata(actual_bmpdata); + datfile:=TFileStream.Create(dat_filename,fmOpenReadWrite); + + id:=StrToInt(MidStr(list_txmp.Items.Strings[list_txmp.ItemIndex],1,5)); + dataddr:=dat_files[id].dataddr; + datfile.Seek(dataddr+$8C,soFromBeginning); + datfile.Read(oldwidth,2); + datfile.Seek(dataddr+$8E,soFromBeginning); + datfile.Read(oldheight,2); + datfile.Seek(dataddr+$88,soFromBeginning); + datfile.Read(oldfading,1); + datfile.Seek(dataddr+$89,soFromBeginning); + datfile.Read(olddepth,1); + datfile.Seek(dataddr+$90,soFromBeginning); + datfile.Read(oldstore,1); + datfile.Seek(dataddr+$9C,soFromBeginning); + datfile.Read(old_rawaddr,4); + IF (oldwidth<>imgpkg.imgx) OR (oldheight<>imgpkg.imgy) THEN BEGIN + IF MessageBox(Form7.Handle, + PChar('Current image and new image have different size'+CrLf+ + '(Current: '+IntToStr(oldwidth)+'x'+IntToStr(oldheight)+ + ' - New: '+IntToStr(imgpkg.imgx)+'x'+IntToStr(imgpkg.imgy)+')'+CrLf+ + 'Replace anyways?'), + PChar('Really replace?'), + MB_YESNO)=IDNO THEN Exit; + END; + + rawfile:=TFileStream.Create(raw_filename,fmOpenReadWrite); + + CASE oldstore OF + 9: oldsize:=GetImageDataSize(oldwidth,oldheight,8,(oldfading AND $01)>0); + 0,1,2: oldsize:=GetImageDataSize(oldwidth,oldheight,16,(oldfading AND $01)>0); + 8: oldsize:=GetImageDataSize(oldwidth,oldheight,32,(oldfading AND $01)>0); + ELSE + oldsize:=0; + END; + newsize:=GetImageDataSize(imgpkg.imgx,imgpkg.imgy,16,Form7.check_fading.Checked); + + IF newsize<=oldsize THEN + new_rawaddr:=old_rawaddr + ELSE + new_rawaddr:=rawfile.Size; + + datbyte:=$00; + IF Form7.check_fading.Checked THEN datbyte:=datbyte OR $01; + datfile.Seek(dataddr+$88,soFromBeginning); + datfile.Write(datbyte,2); + datbyte:=$10; + IF Form7.check_transparency.Checked THEN datbyte:=datbyte OR $04; + datfile.Seek(dataddr+$89,soFromBeginning); + datfile.Write(datbyte,2); + datfile.Seek(dataddr+$8C,soFromBeginning); + datfile.Write(imgpkg.imgx,2); + datfile.Seek(dataddr+$8E,soFromBeginning); + datfile.Write(imgpkg.imgy,2); + datword:=$0001; + datfile.Seek(dataddr+$90,soFromBeginning); + datfile.Write(datword,2); + datfile.Seek(dataddr+$9C,soFromBeginning); + datfile.Write(new_rawaddr,4); + datfile.Free; + + IF Form7.check_fading.Checked THEN BEGIN + imgpkg.imgdata:=CreateFadedImage(imgpkg); + END; + + rawfile.Seek(new_rawaddr,soFromBeginning); + rawfile.Write(imgpkg.imgdata[0],Length(imgpkg.imgdata)); + rawfile.Free; + + ShowMessage('TXMP-image replaced'); + END; + END; + +END. Index: /oup/releases/0.14a/OniUnPacker.bdsproj =================================================================== --- /oup/releases/0.14a/OniUnPacker.bdsproj (revision 21) +++ /oup/releases/0.14a/OniUnPacker.bdsproj (revision 21) @@ -0,0 +1,171 @@ + + + + + + + + + + + + OniUnPacker.dpr + + + 7.0 + + + 8 + 0 + 1 + 1 + 0 + 0 + 1 + 1 + 1 + 0 + 0 + 1 + 0 + 1 + 1 + 1 + 0 + 0 + 0 + 0 + 0 + 1 + 0 + 1 + 1 + 1 + True + True + WinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE; + + False + + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + False + False + False + True + True + True + + + 0 + 0 + 1 + False + False + False + 16384 + 1048576 + 4194304 + + + + + + + + + xmlrtl;rtl;vcl;vclie;inet;inetdbbde;inetdbxpress;vclx;IndySystem;IndyCore;dbrtl;dsnap;soaprtl;IndyProtocols;bdertl;vcldbx;vcldb;webdsnap;websnap;vclactnband;GridPackd2005;TWrapGrid;Package1;A406_R70;CoolTrayIcon_D6plus + + + False + + + + + + False + + + + + + False + + + False + False + 1 + 0 + 0 + 0 + False + False + False + False + False + 1031 + 1252 + + + + + 1.0.0.0 + + + + + + 1.0.0.0 + + + (untitled) + Borland Web Wizard Package + + + Index: /oup/releases/0.14a/OniUnPacker.cfg =================================================================== --- /oup/releases/0.14a/OniUnPacker.cfg (revision 21) +++ /oup/releases/0.14a/OniUnPacker.cfg (revision 21) @@ -0,0 +1,38 @@ +-$A8 +-$B- +-$C+ +-$D+ +-$E- +-$F- +-$G+ +-$H+ +-$I+ +-$J- +-$K- +-$L+ +-$M- +-$N+ +-$O+ +-$P+ +-$Q- +-$R- +-$S- +-$T- +-$U- +-$V+ +-$W- +-$X+ +-$YD +-$Z1 +-cg +-AWinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE; +-H+ +-W+ +-M +-$M16384,1048576 +-K$00400000 +-LE"C:\Dokumente und Einstellungen\Administrator\Eigene Dateien\Borland Studio Projects\Bpl" +-LN"C:\Dokumente und Einstellungen\Administrator\Eigene Dateien\Borland Studio Projects\Bpl" +-w-UNSAFE_TYPE +-w-UNSAFE_CODE +-w-UNSAFE_CAST Index: /oup/releases/0.14a/OniUnPacker.dpr =================================================================== --- /oup/releases/0.14a/OniUnPacker.dpr (revision 21) +++ /oup/releases/0.14a/OniUnPacker.dpr (revision 21) @@ -0,0 +1,21 @@ +PROGRAM OniUnPacker; +uses + Forms, + Unit1_main in 'Unit1_main.pas' {Form1}, + Unit2_functions in 'Unit2_functions.pas', + Unit3_data in 'Unit3_data.pas', + Unit4_Exporters in 'Unit4_Exporters.pas', + Unit5_preview in 'Unit5_preview.pas' {Form5}, + Unit6_imgfuncs in 'Unit6_imgfuncs.pas', + Unit7_txmpreplace in 'Unit7_txmpreplace.pas' {Form7}; + +{$R *.res} + +BEGIN + Application.Initialize; + Application.Title:='Oni Un/Packer'; + Application.CreateForm(TForm1, Form1); + Application.CreateForm(TForm5, Form5); + Application.CreateForm(TForm7, Form7); + Application.Run; +END. Index: /oup/releases/0.14a/SQLite3.pas =================================================================== --- /oup/releases/0.14a/SQLite3.pas (revision 21) +++ /oup/releases/0.14a/SQLite3.pas (revision 21) @@ -0,0 +1,120 @@ +unit SQLite3; + +{ + Simplified interface for SQLite. + Updated for Sqlite 3 by Tim Anderson (tim@itwriting.com) + Note: NOT COMPLETE for version 3, just minimal functionality + Adapted from file created by Pablo Pissanetzky (pablo@myhtpc.net) + which was based on SQLite.pas by Ben Hochstrasser (bhoc@surfeu.ch) +} + +interface + +const +// Return values for sqlite3_exec() and sqlite3_step() + +SQLITE_OK = 0; // Successful result +SQLITE_ERROR = 1; // SQL error or missing database +SQLITE_INTERNAL = 2; // An internal logic error in SQLite +SQLITE_PERM = 3 ; // Access permission denied +SQLITE_ABORT = 4; // Callback routine requested an abort +SQLITE_BUSY = 5; // The database file is locked +SQLITE_LOCKED = 6; // A table in the database is locked +SQLITE_NOMEM = 7; // A malloc() failed +SQLITE_READONLY = 8; // Attempt to write a readonly database +SQLITE_INTERRUPT = 9; // Operation terminated by sqlite3_interrupt() +SQLITE_IOERR = 10; // Some kind of disk I/O error occurred +SQLITE_CORRUPT = 11; // The database disk image is malformed +SQLITE_NOTFOUND = 12; // (Internal Only) Table or record not found +SQLITE_FULL = 13; // Insertion failed because database is full +SQLITE_CANTOPEN = 14; // Unable to open the database file +SQLITE_PROTOCOL = 15; // Database lock protocol error +SQLITE_EMPTY = 16; // Database is empty +SQLITE_SCHEMA = 17; // The database schema changed +SQLITE_TOOBIG = 18; // Too much data for one row of a table +SQLITE_CONSTRAINT = 19; // Abort due to contraint violation +SQLITE_MISMATCH = 20; // Data type mismatch +SQLITE_MISUSE = 21; // Library used incorrectly +SQLITE_NOLFS = 22; // Uses OS features not supported on host +SQLITE_AUTH = 23; // Authorization denied +SQLITE_FORMAT = 24; // Auxiliary database format error +SQLITE_RANGE = 25; // 2nd parameter to sqlite3_bind out of range +SQLITE_NOTADB = 26; // File opened that is not a database file +SQLITE_ROW = 100; // sqlite3_step() has another row ready +SQLITE_DONE = 101; // sqlite3_step() has finished executing + +SQLITE_INTEGER = 1; +SQLITE_FLOAT = 2; +SQLITE_TEXT = 3; +SQLITE_BLOB = 4; +SQLITE_NULL = 5; + +type +TSQLiteDB = Pointer; +TSQLiteResult = ^PChar; +TSQLiteStmt = Pointer; + +function SQLite3_Open (dbname: PChar; var db: TSqliteDB): integer; cdecl; external 'sqlite3.dll' name 'sqlite3_open'; +function SQLite3_Close (db: TSQLiteDB): integer; cdecl; external 'sqlite3.dll' name 'sqlite3_close'; +function SQLite3_Exec (db: TSQLiteDB; SQLStatement: PChar; CallbackPtr: Pointer; Sender: TObject; var ErrMsg: PChar): integer; cdecl; external 'sqlite3.dll' name 'sqlite3_exec'; +function SQLite3_Version (): PChar; cdecl; external 'sqlite3.dll' name 'sqlite3_libversion'; +function SQLite3_ErrMsg (db: TSQLiteDB): PChar; cdecl; external 'sqlite3.dll' name 'sqlite3_errmsg'; +function SQLite3_ErrCode (db: TSQLiteDB): integer; cdecl; external 'sqlite3.dll' name 'sqlite3_errcode'; +procedure SQlite3_Free (P: PChar); cdecl; external 'sqlite3.dll' name 'sqlite3_free'; +function SQLite3_GetTable (db: TSQLiteDB; SQLStatement: PChar; var ResultPtr: TSQLiteResult; var RowCount: Cardinal; var ColCount: Cardinal; var ErrMsg: PChar): integer; cdecl; external 'sqlite3.dll' name 'sqlite3_get_table'; +procedure SQLite3_FreeTable (Table:TSQLiteResult ); cdecl; external 'sqlite3.dll' name 'sqlite3_free_table'; +function SQLite3_Complete (P: PChar): boolean; cdecl; external 'sqlite3.dll' name 'sqlite3_complete'; +function SQLite3_LastInsertRowID(db: TSQLiteDB): int64; cdecl; external 'sqlite3.dll' name 'sqlite3_last_insert_rowid'; +procedure SQLite3_Interrupt (db: TSQLiteDB); cdecl; external 'sqlite3.dll' name 'sqlite3_interrupt'; +procedure SQLite3_BusyHandler (db: TSQLiteDB; CallbackPtr: Pointer; Sender: TObject); cdecl; external 'sqlite3.dll' name'sqlite3_busy_handler' ; +procedure SQLite3_BusyTimeout (db: TSQLiteDB; TimeOut: integer); cdecl; external 'sqlite3.dll' name 'sqlite3_busy_timeout'; +function SQLite3_Changes (db: TSQLiteDB): integer; cdecl; external 'sqlite3.dll' name 'sqlite3_changes'; +function SQLite3_TotalChanges (db: TSQLiteDB): integer; cdecl; external 'sqlite3.dll' name 'sqlite3_total_changes'; +function SQLite3_Prepare (db: TSQLiteDB; SQLStatement: PChar; nBytes: integer; var hStmt: TSqliteStmt; var pzTail: PChar): integer; cdecl; external 'sqlite3.dll' name 'sqlite3_prepare'; +function SQLite3_ColumnCount (hStmt: TSqliteStmt): integer; cdecl; external 'sqlite3.dll' name 'sqlite3_column_count'; +function Sqlite3_ColumnName (hStmt: TSqliteStmt; ColNum: integer): pchar; cdecl; external 'sqlite3.dll' name 'sqlite3_column_name'; +function Sqlite3_ColumnDeclType (hStmt: TSqliteStmt; ColNum: integer): pchar; cdecl; external 'sqlite3.dll' name 'sqlite3_column_decltype'; +function Sqlite3_Step (hStmt: TSqliteStmt): integer; cdecl; external 'sqlite3.dll' name 'sqlite3_step'; +function SQLite3_DataCount (hStmt: TSqliteStmt): integer; cdecl; external 'sqlite3.dll' name 'sqlite3_data_count'; + +function Sqlite3_ColumnBlob (hStmt: TSqliteStmt; ColNum: integer):pointer; cdecl; external 'sqlite3.dll' name 'sqlite3_column_blob'; +function Sqlite3_ColumnBytes (hStmt: TSqliteStmt; ColNum: integer): integer; cdecl; external 'sqlite3.dll' name 'sqlite3_column_bytes'; +function Sqlite3_ColumnDouble (hStmt: TSqliteStmt; ColNum: integer): double; cdecl; external 'sqlite3.dll' name 'sqlite3_column_double'; +function Sqlite3_ColumnInt (hStmt: TSqliteStmt; ColNum: integer): integer; cdecl; external 'sqlite3.dll' name 'sqlite3_column_int'; +function Sqlite3_ColumnText (hStmt: TSqliteStmt; ColNum: integer): pchar; cdecl; external 'sqlite3.dll' name 'sqlite3_column_text'; +function Sqlite3_ColumnType (hStmt: TSqliteStmt; ColNum: integer): integer; cdecl; external 'sqlite3.dll' name 'sqlite3_column_type'; + // function Sqlite3_ColumnInt64 (hStmt: TSqliteStmt; ColNum: integer): SqliteInt64; cdecl; external 'sqlite3.dll' name 'sqlite3_column_int64'; +function SQLite3_Finalize (hStmt: TSqliteStmt): integer; cdecl; external 'sqlite3.dll' name 'sqlite3_finalize'; +function SQLite3_Reset (hStmt: TSqliteStmt): integer; cdecl; external 'sqlite3.dll' name 'sqlite3_reset'; + +// +// In the SQL strings input to sqlite3_prepare() and sqlite3_prepare16(), +// one or more literals can be replace by a wildcard "?" or ":N:" where +// N is an integer. These value of these wildcard literals can be set +// using the routines listed below. +// +// In every case, the first parameter is a pointer to the sqlite3_stmt +// structure returned from sqlite3_prepare(). The second parameter is the +// index of the wildcard. The first "?" has an index of 1. ":N:" wildcards +// use the index N. +// + // The fifth parameter to sqlite3_bind_blob(), sqlite3_bind_text(), and + //sqlite3_bind_text16() is a destructor used to dispose of the BLOB or +//text after SQLite has finished with it. If the fifth argument is the +// special value SQLITE_STATIC, then the library assumes that the information +// is in static, unmanaged space and does not need to be freed. If the +// fifth argument has the value SQLITE_TRANSIENT, then SQLite makes its +// own private copy of the data. +// +// The sqlite3_bind_* routine must be called before sqlite3_step() after +// an sqlite3_prepare() or sqlite3_reset(). Unbound wildcards are interpreted +// as NULL. +// + +function SQLite3_BindBlob(hStmt: TSqliteStmt; ParamNum: integer; +ptrData: pointer; numBytes: integer; ptrDestructor: pointer): integer; +cdecl; external 'sqlite3.dll' name 'sqlite3_bind_blob'; + +implementation + +end. Index: /oup/releases/0.14a/SQLiteTable3.pas =================================================================== --- /oup/releases/0.14a/SQLiteTable3.pas (revision 21) +++ /oup/releases/0.14a/SQLiteTable3.pas (revision 21) @@ -0,0 +1,883 @@ +unit SQLiteTable3; + +{ + Simple classes for using SQLite's exec and get_table. + + TSQLiteDatabase wraps the calls to open and close an SQLite database. + It also wraps SQLite_exec for queries that do not return a result set + + TSQLiteTable wraps sqlite_get_table. + It allows accessing fields by name as well as index and can step through a + result set with the Next procedure. + + Adapted by Tim Anderson (tim@itwriting.com) + Originally created by Pablo Pissanetzky (pablo@myhtpc.net) +} + +interface + +uses + Windows, SQLite3, Classes, Sysutils; + +const + dtStr = 0; + dtInt = 1; + dtBool = 2; + dtNumeric = 3; + dtBlob = 4; + +type + + ESQLiteException = class(Exception) + private + public + end; + + TSQLiteTable = class; + + TSQLiteDatabase = class + private + fDB: TSQLiteDB; + fInTrans: Boolean; + procedure RaiseError(s: string; SQL: string); + + public + constructor Create(const FileName: string); + destructor Destroy; override; + function GetTable(const SQL: string): TSQLiteTable; + procedure ExecSQL(const SQL: string); + procedure UpdateBlob(const SQL: string; BlobData: TStream); + procedure BeginTransaction; + procedure Commit; + procedure Rollback; + function TableExists(TableName: string): boolean; + function GetLastInsertRowID: int64; + + published + property isTransactionOpen: boolean read fInTrans; + + end; + + TSQLiteTable = class + private + fResults: TList; + fRowCount: Cardinal; + fColCount: Cardinal; + fCols: TStringList; + fColTypes: TList; + fRow: Cardinal; + + function GetFields(I: Integer): string; + function GetEOF: Boolean; + function GetBOF: Boolean; + function GetColumns(I: Integer): string; + function GetFieldByName(FieldName: string): string; + function GetFieldIndex(FieldName: string): integer; + function GetCount: Integer; + function GetCountResult: Integer; + + + public + constructor Create(DB: TSQLiteDatabase; const SQL: string); + destructor Destroy; override; + function FieldAsInteger(FieldName: string): integer; + function FieldAsBool(FieldName: string): boolean; + function FieldAsBlob(FieldName: string): TMemoryStream; + function FieldAsBlobText(FieldName: string): string; + function FieldIsNull(FieldName: string): boolean; + function FieldAsString(FieldName: string): string; + function FieldAsDouble(FieldName: string): double; +{ function FieldAsInteger(I: integer): integer; + function FieldAsBool(I: integer): boolean; + function FieldAsBlob(I: Integer): TMemoryStream; + function FieldAsBlobText(I: Integer): string; + function FieldIsNull(I: integer): boolean; + function FieldAsString(I: Integer): string; + function FieldAsDouble(I: Integer): double; +} function Next: Boolean; + function Previous: Boolean; + property EOF: Boolean read GetEOF; + property BOF: Boolean read GetBOF; + property Fields[I: Integer]: string read GetFields; + property FieldByName[FieldName: string]: string read GetFieldByName; + property FieldIndex[FieldName: string]: integer read GetFieldIndex; + property Columns[I: Integer]: string read GetColumns; + property ColCount: Cardinal read fColCount; + property RowCount: Cardinal read fRowCount; + property Row: Cardinal read fRow; + function MoveFirst: boolean; + function MoveLast: boolean; + + + property Count: Integer read GetCount; + + // The property CountResult is used when you execute count(*) queries. + // It returns 0 if the result set is empty or the value of the + // first field as an integer. + property CountResult: Integer read GetCountResult; + end; + + +procedure DisposePointer(ptr: pointer); cdecl; + +implementation + +uses + strutils; + + +procedure DisposePointer(ptr: pointer); cdecl; +begin + + if assigned(ptr) then + begin freemem(ptr) end; + +end; + +//------------------------------------------------------------------------------ +// TSQLiteDatabase +//------------------------------------------------------------------------------ + +constructor TSQLiteDatabase.Create(const FileName: string); +var + Msg: pchar; + iResult: integer; +begin + inherited Create; + + self.fInTrans := false; + + Msg := nil; + try + iResult := SQLite3_Open(PChar(FileName), Fdb); + + if iResult <> SQLITE_OK then + begin + if Assigned(Fdb) then + begin + Msg := Sqlite3_ErrMsg(Fdb); + raise ESqliteException.CreateFmt('Failed to open database "%s" : %s', [FileName, Msg]); + end + else + begin raise ESqliteException.CreateFmt('Failed to open database "%s" : unknown error', [FileName]) end; + end; + + //set a few configs + self.ExecSQL('PRAGMA SYNCHRONOUS=NORMAL;'); + + //this pragma not recommended and may disappear in future + //sqlite versions + //self.ExecSQL('PRAGMA full_column_names = 1;'); + + finally + if Assigned(Msg) then + begin SQLite3_Free(Msg) end; + end; + + +end; + + +//.............................................................................. + +destructor TSQLiteDatabase.Destroy; +begin + + if self.fInTrans then + begin self.ExecSQL('ROLLBACK;') end; //assume rollback + + if Assigned(fDB) then + begin SQLite3_Close(fDB) end; + + inherited; +end; + +function TSQLiteDatabase.GetLastInsertRowID: int64; +begin + result := Sqlite3_LastInsertRowID(self.fDB); +end; + +//.............................................................................. + +procedure TSQLiteDatabase.RaiseError(s: string; SQL: string); +//look up last error and raise and exception with an appropriate message +var + Msg: PChar; +begin + + Msg := nil; + + if sqlite3_errcode(self.fDB) <> SQLITE_OK then + Msg := sqlite3_errmsg(self.fDB); + + if Msg <> nil then + raise ESqliteException.CreateFmt(s + ' "%s" : %s', [SQL, Msg]) + else + raise ESqliteException.CreateFmt(s, [SQL, 'No message']); + +end; + +procedure TSQLiteDatabase.ExecSQL(const SQL: string); +var + Stmt: TSQLiteStmt; + NextSQLStatement: Pchar; + iStepResult: integer; +begin + try + + if Sqlite3_Prepare(self.fDB, PChar(SQL), -1, Stmt, NextSQLStatement) <> SQLITE_OK then + begin RaiseError('Error executing SQL', SQL) end; + + if (Stmt = nil) then + begin RaiseError('Could not prepare SQL statement', SQL) end; + + iStepResult := Sqlite3_step(Stmt); + + if (iStepResult <> SQLITE_DONE) then + begin RaiseError('Error executing SQL statement', SQL) end; + + finally + + if Assigned(Stmt) then + begin Sqlite3_Finalize(stmt) end; + + end; +end; + +procedure TSQLiteDatabase.UpdateBlob(const SQL: string; BlobData: TStream); +var + iSize: integer; + ptr: pointer; + Stmt: TSQLiteStmt; + Msg: Pchar; + NextSQLStatement: Pchar; + iStepResult: integer; + iBindResult: integer; +begin +//expects SQL of the form 'UPDATE MYTABLE SET MYFIELD = ? WHERE MYKEY = 1' + + if pos('?', SQL) = 0 then + begin RaiseError('SQL must include a ? parameter', SQL) end; + + Msg := nil; + try + + if Sqlite3_Prepare(self.fDB, PChar(SQL), -1, Stmt, NextSQLStatement) <> SQLITE_OK then + begin RaiseError('Could not prepare SQL statement', SQL) end; + + if (Stmt = nil) then + begin RaiseError('Could not prepare SQL statement', SQL) end; + +//now bind the blob data + iSize := BlobData.size; + + GetMem(ptr, iSize); + + if (ptr = nil) then + begin raise ESqliteException.CreateFmt('Error getting memory to save blob', [SQL, 'Error']) end; + + BlobData.position := 0; + BlobData.Read(ptr^, iSize); + + iBindResult := SQLite3_BindBlob(stmt, 1, ptr, iSize, @DisposePointer); + + if iBindResult <> SQLITE_OK then + begin RaiseError('Error binding blob to database', SQL) end; + + iStepResult := Sqlite3_step(Stmt); + + if (iStepResult <> SQLITE_DONE) then + begin RaiseError('Error executing SQL statement', SQL) end; + + finally + + if Assigned(Stmt) then + begin Sqlite3_Finalize(stmt) end; + + if Assigned(Msg) then + begin SQLite3_Free(Msg) end; + end; + +end; + +//.............................................................................. + +function TSQLiteDatabase.GetTable(const SQL: string): TSQLiteTable; +begin + Result := TSQLiteTable.Create(Self, SQL); +end; + +procedure TSQLiteDatabase.BeginTransaction; +begin + if not self.fInTrans then + begin + self.ExecSQL('BEGIN TRANSACTION;'); + self.fInTrans := true; + end + else + begin raise ESqliteException.Create('Transaction already open') end; +end; + +procedure TSQLiteDatabase.Commit; +begin + self.ExecSQL('COMMIT;'); + self.fInTrans := false; +end; + +procedure TSQLiteDatabase.Rollback; +begin + self.ExecSQL('ROLLBACK;'); + self.fInTrans := false; +end; + +function TSQLiteDatabase.TableExists(TableName: string): boolean; +var + sql: string; + ds: TSqliteTable; +begin +//returns true if table exists in the database + sql := 'select [sql] from sqlite_master where [type] = ''table'' and lower(name) = ''' + lowercase(TableName) + ''' '; + + try + + ds := self.GetTable(sql); + + result := (ds.Count > 0); + + finally + + freeandnil(ds); + + end; + +end; + + +//------------------------------------------------------------------------------ +// TSQLiteTable +//------------------------------------------------------------------------------ + +constructor TSQLiteTable.Create(DB: TSQLiteDatabase; const SQL: string); +var + Stmt: TSQLiteStmt; + NextSQLStatement: Pchar; + iStepResult: integer; + + ptr: pointer; + iNumBytes: integer; + thisBlobValue: TMemoryStream; + thisStringValue: pstring; + thisBoolValue: pBoolean; + thisDoubleValue: pDouble; + thisIntValue: pInteger; + thisColType: pInteger; + i: integer; + DeclaredColType: Pchar; + ActualColType: integer; + ptrValue: Pchar; + +begin + + try + + self.fRowCount := 0; + self.fColCount := 0; + +//if there are several SQL statements in SQL, NextSQLStatment points to the +//beginning of the next one. Prepare only prepares the first SQL statement. + + if Sqlite3_Prepare(Db.fDB, PChar(SQL), -1, Stmt, NextSQLStatement) <> SQLITE_OK then + begin Db.RaiseError('Error executing SQL', SQL) end; + + if (Stmt = nil) then + begin Db.RaiseError('Could not prepare SQL statement', SQL) end; + + iStepResult := Sqlite3_step(Stmt); + + while (iStepResult <> SQLITE_DONE) do + begin + + case iStepResult of + SQLITE_ROW: + begin + + inc(fRowCount); + + if (fRowCount = 1) then + begin + //get data types + fCols := TStringList.Create; + fCols.CaseSensitive := False; + fColTypes := TList.Create; + + fColCount := SQLite3_ColumnCount(stmt); + + for i := 0 to Pred(fColCount) do + begin + fCols.Add(Sqlite3_ColumnName(stmt, i)); + end; + + for i := 0 to Pred(fColCount) do + begin + + new(thisColType); + DeclaredColType := Sqlite3_ColumnDeclType(stmt, i); + + if DeclaredColType = nil then begin + //use the actual column type instead + //seems to be needed for last_insert_rowid + thisColType^ := Sqlite3_ColumnType(stmt, i); + end else begin + DeclaredColType := strupper(DeclaredColType); + + if DeclaredColType = 'INTEGER' then + begin thisColType^ := dtInt end + else + if DeclaredColType = 'BOOLEAN' then + begin thisColType^ := dtBool end + else + if (DeclaredColType = 'NUMERIC') or (DeclaredColType = 'FLOAT') or (DeclaredColType = 'DOUBLE') then + begin thisColType^ := dtNumeric end + else + if DeclaredColType = 'BLOB' then + begin thisColType^ := dtBlob end + else + begin thisColType^ := dtStr end; + end; + + fColTypes.Add(thiscoltype); + end; + + fResults := TList.Create; + + end; + + //get column values + for i := 0 to Pred(ColCount) do + begin + + ActualColType := Sqlite3_ColumnType(stmt, i); + if (ActualColType = SQLITE_NULL) then + begin fResults.Add(nil) end + else + begin + if pInteger(fColTypes[i])^ = dtInt then + begin + new(thisintvalue); + thisintvalue^ := Sqlite3_ColumnInt(stmt, i); + fResults.Add(thisintvalue); + end + else + if pInteger(fColTypes[i])^ = dtBool then + begin + new(thisboolvalue); + thisboolvalue^ := not (Sqlite3_ColumnInt(stmt, i) = 0); + fResults.Add(thisboolvalue); + end + else + if pInteger(fColTypes[i])^ = dtNumeric then + begin + new(thisdoublevalue); + thisdoublevalue^ := Sqlite3_ColumnDouble(stmt, i); + fResults.Add(thisdoublevalue); + end + else + if pInteger(fColTypes[i])^ = dtBlob then + begin + iNumBytes := Sqlite3_ColumnBytes(stmt, i); + + if iNumBytes = 0 then + begin thisblobvalue := nil end + else + begin + thisblobvalue := TMemoryStream.Create; + thisblobvalue.position := 0; + ptr := Sqlite3_ColumnBlob(stmt, i); + thisblobvalue.writebuffer(ptr^, iNumBytes); + end; + fResults.Add(thisblobvalue); + + end + else + begin + new(thisstringvalue); + ptrValue := Sqlite3_ColumnText(stmt, i); + setstring(thisstringvalue^, ptrvalue, strlen(ptrvalue)); + fResults.Add(thisstringvalue); + end; + end; + + end; + + + + end; + + SQLITE_BUSY: + begin raise ESqliteException.CreateFmt('Could not prepare SQL statement', [SQL, 'SQLite is Busy']) end; + else + begin Db.RaiseError('Could not retrieve data', SQL) end; + end; + + iStepResult := Sqlite3_step(Stmt); + + end; + + fRow := 0; + + finally + if Assigned(Stmt) then + begin Sqlite3_Finalize(stmt) end; + end; + +end; + +//.............................................................................. + +destructor TSQLiteTable.Destroy; +var i: integer; + iColNo: integer; +begin + + + if Assigned(fResults) then + begin for i := 0 to fResults.Count - 1 do + begin + //check for blob type + iColNo := (i mod fColCount); + case pInteger(self.fColTypes[iColNo])^ of + dtBlob: + begin + TMemoryStream(fResults[i]).free; + end; + dtStr: + begin + if fResults[i] <> nil then + begin + setstring(string(fResults[i]^), nil, 0); + dispose(fResults[i]); + end; + end; + else + begin + dispose(fResults[i]) + end; + end; + end; + fResults.Free; + end; + + if Assigned(fCols) then + begin fCols.Free end; + + if Assigned(fColTypes) then + begin for i := 0 to fColTypes.Count - 1 do + begin + dispose(fColTypes[i]); + end end; + fColTypes.Free; + inherited; + end; + +//.............................................................................. + +function TSQLiteTable.GetColumns(I: Integer): string; +begin + Result := fCols[I]; +end; + +//.............................................................................. + +function TSQLiteTable.GetCountResult: Integer; +begin + if not EOF then + begin Result := StrToInt(Fields[0]) end + else + begin Result := 0 end; +end; + +function TSQLiteTable.GetCount: Integer; +begin + Result := FRowCount; +end; + +//.............................................................................. + +function TSQLiteTable.GetEOF: Boolean; +begin + Result := fRow >= fRowCount; +end; + +function TSQLiteTable.GetBOF: Boolean; +begin + Result := fRow <= 0; +end; + +//.............................................................................. + +function TSQLiteTable.GetFieldByName(FieldName: string): string; +begin + Result := GetFields(self.GetFieldIndex(FieldName)); +end; + +function TSQLiteTable.GetFieldIndex(FieldName: string): integer; +begin + + if (fCols = nil) then + begin + raise ESqliteException.Create('Field ' + fieldname + ' Not found. Empty dataset'); + exit; + end; + + if (fCols.count = 0) then + begin + raise ESqliteException.Create('Field ' + fieldname + ' Not found. Empty dataset'); + exit; + end; + + result := fCols.IndexOf(FieldName); + + if (result < 0) then + begin raise ESqliteException.Create('Field not found in dataset: ' + fieldname) end; + +end; + +//.............................................................................. + +function TSQLiteTable.GetFields(I: Integer): string; +var + thisvalue: pstring; + ptr: pointer; + thisboolvalue: pBoolean; + thistype: integer; +begin + Result := ''; + + if EOF then + begin raise ESqliteException.Create('Table is at End of File') end; + +//integer and boolean types are not stored in the resultset +//as strings, so they should be retrieved using the type-specific +//methods + + thistype := pInteger(self.fColTypes[I])^; + + if (thistype = dtInt) or (thistype = dtNumeric) or (thistype = dtBlob) then + begin + ptr := self.fResults[(self.frow * self.fColCount) + I]; + + if ptr <> nil then + begin + raise ESqliteException.Create('Use the specific methods for integer, numeric or blob fields'); + end; + + end + else + if pInteger(self.fColTypes[I])^ = dtBool then + begin + thisboolvalue := self.fResults[(self.frow * self.fColCount) + I]; + if thisboolvalue <> nil then + begin if thisboolvalue^ then + begin result := '1' end + else + begin result := '0' end end; + end + + else + + begin + + thisvalue := self.fResults[(self.frow * self.fColCount) + I]; + if (thisvalue <> nil) then + begin Result := thisvalue^ end + else + begin Result := '' end; //return empty string + end; + +end; + +function TSqliteTable.FieldAsBlob(FieldName: string): TMemoryStream; +var + i: Integer; +begin + + if EOF then + begin raise ESqliteException.Create('Table is at End of File') end; + + i:=Self.FieldIndex[FieldName]; + + if (self.fResults[(self.frow * self.fColCount) + I] = nil) then + begin result := nil end + else + if pInteger(self.fColTypes[I])^ = dtBlob then + begin result := TMemoryStream(self.fResults[(self.frow * self.fColCount) + I]) end + else + begin raise ESqliteException.Create('Not a Blob field') end; +end; + +function TSqliteTable.FieldAsBlobText(FieldName: string): string; +var + MemStream: TMemoryStream; + Buffer: PChar; +begin + result := ''; + + MemStream := self.FieldAsBlob(FieldName); + + if MemStream <> nil then + begin if MemStream.Size > 0 then + begin + MemStream.position := 0; + + Buffer := stralloc(MemStream.Size + 1); + MemStream.readbuffer(Buffer[0], MemStream.Size); + (Buffer + MemStream.Size)^ := chr(0); + SetString(Result, Buffer, MemStream.size); + strdispose(Buffer); + end end; + +end; + + +function TSqliteTable.FieldAsInteger(FieldName: string): integer; +var + i: Integer; +begin + + if EOF then + begin raise ESqliteException.Create('Table is at End of File') end; + + i:=Self.FieldIndex[FieldName]; + + if (self.fResults[(self.frow * self.fColCount) + I] = nil) then + begin result := 0 end + else + if pInteger(self.fColTypes[I])^ = dtInt then + begin result := pInteger(self.fResults[(self.frow * self.fColCount) + I])^ end + else + if pInteger(self.fColTypes[I])^ = dtNumeric then + begin result := trunc(strtofloat(pString(self.fResults[(self.frow * self.fColCount) + I])^)) end + else + begin raise ESqliteException.Create('Not an integer or numeric field') end; + +end; + +function TSqliteTable.FieldAsDouble(FieldName: string): double; +var + i: Integer; +begin + + if EOF then + begin raise ESqliteException.Create('Table is at End of File') end; + + i:=Self.FieldIndex[FieldName]; + + if (self.fResults[(self.frow * self.fColCount) + I] = nil) then + begin result := 0 end + else + if pInteger(self.fColTypes[I])^ = dtInt then + begin result := pInteger(self.fResults[(self.frow * self.fColCount) + I])^ end + else + if pInteger(self.fColTypes[I])^ = dtNumeric then + begin result := pDouble(self.fResults[(self.frow * self.fColCount) + I])^ end + else + begin raise ESqliteException.Create('Not an integer or numeric field') end; + +end; + +function TSqliteTable.FieldAsBool(FieldName: string): boolean; +var + i: Integer; +begin + + if EOF then + begin raise ESqliteException.Create('Table is at End of File') end; + + i:=Self.FieldIndex[FieldName]; + + if (self.fResults[(self.frow * self.fColCount) + I] = nil) then + begin result := false end + else + if pInteger(self.fColTypes[I])^ = dtBool then + begin result := pBoolean(self.fResults[(self.frow * self.fColCount) + I])^ end + else + begin raise ESqliteException.Create('Not a boolean field') end; +end; + +function TSqliteTable.FieldAsString(FieldName: string): string; +var + i: Integer; +begin + + if EOF then + begin raise ESqliteException.Create('Table is at End of File') end; + + i:=Self.FieldIndex[FieldName]; + + if (self.fResults[(self.frow * self.fColCount) + I] = nil) then + begin result := '' end + else + begin result := self.GetFields(I) end; + +end; + +function TSqliteTable.FieldIsNull(FieldName: string): boolean; +var + thisvalue: pointer; + i: Integer; +begin + + if EOF then + begin raise ESqliteException.Create('Table is at End of File') end; + + i:=Self.FieldIndex[FieldName]; + + thisvalue := self.fResults[(self.frow * self.fColCount) + I]; + result := (thisvalue = nil); +end; + +//.............................................................................. + +function TSQLiteTable.Next: boolean; +begin + result := false; + if not EOF then + begin + Inc(fRow); + result := true; + end; +end; + +function TSQLiteTable.Previous: boolean; +begin + result := false; + if not BOF then + begin + Dec(fRow); + result := true; + end; +end; + +function TSQLiteTable.MoveFirst: boolean; +begin + result := false; + if self.fRowCount > 0 then + begin + fRow := 0; + result := true; + end; +end; + +function TSQLiteTable.MoveLast: boolean; +begin + result := false; + if self.fRowCount > 0 then + begin + fRow := fRowCount - 1; + result := true; + end; +end; + + +end. + Index: /oup/releases/0.14a/Unit1_main.dfm =================================================================== --- /oup/releases/0.14a/Unit1_main.dfm (revision 21) +++ /oup/releases/0.14a/Unit1_main.dfm (revision 21) @@ -0,0 +1,301 @@ +object Form1: TForm1 + Left = 0 + Top = 0 + HorzScrollBar.Visible = False + VertScrollBar.Visible = False + AutoScroll = False + Caption = 'Form1' + ClientHeight = 435 + ClientWidth = 742 + Color = clBtnFace + Font.Charset = DEFAULT_CHARSET + Font.Color = clWindowText + Font.Height = -11 + Font.Name = 'Tahoma' + Font.Style = [] + Menu = menu + OldCreateOrder = False + OnClose = FormClose + OnCreate = FormCreate + OnResize = FormResize + PixelsPerInch = 96 + TextHeight = 13 + object panel_all: TPanel + Left = 0 + Top = 100 + Width = 692 + Height = 300 + BevelOuter = bvNone + TabOrder = 0 + object Splitter2: TSplitter + Left = 360 + Top = 0 + Width = 8 + Height = 300 + AutoSnap = False + Beveled = True + MinSize = 360 + OnMoved = Splitter2Moved + end + object panel_left: TPanel + Left = 0 + Top = 0 + Width = 360 + Height = 300 + Cursor = crDrag + Align = alLeft + BevelOuter = bvNone + TabOrder = 0 + object Splitter1: TSplitter + Left = 0 + Top = 241 + Width = 360 + Height = 8 + Cursor = crVSplit + Align = alTop + AutoSnap = False + Beveled = True + MinSize = 75 + OnMoved = Splitter1Moved + end + object panel_files: TPanel + Left = 0 + Top = 0 + Width = 360 + Height = 241 + Align = alTop + BevelOuter = bvNone + TabOrder = 0 + object btn_extractallconvert: TButton + Left = 273 + Top = 208 + Width = 82 + Height = 33 + Caption = 'Extract all (with convert)' + TabOrder = 0 + WordWrap = True + OnClick = btn_extractallconvertClick + end + object btn_extract: TButton + Left = 0 + Top = 208 + Width = 100 + Height = 33 + Caption = 'Extract file (without convert)' + TabOrder = 1 + WordWrap = True + OnClick = btn_extractconvertClick + end + object btn_extractconvert: TButton + Left = 101 + Top = 208 + Width = 105 + Height = 33 + Caption = 'Extract file (with convert if possible)' + TabOrder = 2 + WordWrap = True + OnClick = btn_extractconvertClick + end + object list_files: TListBox + Left = 0 + Top = 0 + Width = 360 + Height = 209 + Align = alTop + Font.Charset = DEFAULT_CHARSET + Font.Color = clWindowText + Font.Height = -11 + Font.Name = 'Fixedsys' + Font.Style = [] + ItemHeight = 15 + ParentFont = False + TabOrder = 3 + OnClick = list_filesDblClick + OnDblClick = list_filesDblClick + end + object btn_extractall: TButton + Left = 210 + Top = 208 + Width = 62 + Height = 33 + Caption = 'Extract all' + TabOrder = 4 + WordWrap = True + OnClick = btn_extractallconvertClick + end + end + object list_extensions: TListBox + Left = 0 + Top = 249 + Width = 360 + Height = 51 + Align = alClient + Font.Charset = DEFAULT_CHARSET + Font.Color = clWindowText + Font.Height = -11 + Font.Name = 'Fixedsys' + Font.Style = [] + ItemHeight = 15 + ParentFont = False + Sorted = True + TabOrder = 1 + OnClick = list_extensionsClick + OnDblClick = list_extensionsClick + end + end + object panel_right: TPanel + Left = 368 + Top = 0 + Width = 324 + Height = 300 + Align = alClient + BevelOuter = bvNone + TabOrder = 1 + object Splitter3: TSplitter + Left = 0 + Top = 200 + Width = 324 + Height = 8 + Cursor = crVSplit + Align = alTop + AutoSnap = False + Beveled = True + MinSize = 75 + end + object edit_data: TMemo + Left = 0 + Top = 0 + Width = 324 + Height = 200 + Align = alTop + Font.Charset = DEFAULT_CHARSET + Font.Color = clWindowText + Font.Height = -13 + Font.Name = 'Fixedsys' + Font.Style = [] + ParentFont = False + ReadOnly = True + ScrollBars = ssVertical + TabOrder = 0 + WordWrap = False + end + object list_names: TListBox + Left = 0 + Top = 208 + Width = 324 + Height = 92 + Align = alClient + Font.Charset = DEFAULT_CHARSET + Font.Color = clWindowText + Font.Height = -11 + Font.Name = 'Fixedsys' + Font.Style = [] + ItemHeight = 15 + ParentFont = False + Sorted = True + TabOrder = 1 + end + end + end + object panel_info: TPanel + Left = 0 + Top = 0 + Width = 742 + Height = 100 + Align = alTop + BevelOuter = bvNone + TabOrder = 1 + object lbl_info: TLabel + Left = 2 + Top = 26 + Width = 345 + Height = 73 + AutoSize = False + end + object lbl_fileinfo: TLabel + Left = 380 + Top = 0 + Width = 345 + Height = 99 + AutoSize = False + end + object btn_load: TButton + Left = 0 + Top = 0 + Width = 81 + Height = 25 + Caption = 'Load dat-file' + TabOrder = 0 + OnClick = btn_loadClick + end + object btn_hexcopy: TButton + Left = 295 + Top = 64 + Width = 89 + Height = 33 + Caption = 'Copy filedata as hex to clipboard' + TabOrder = 1 + WordWrap = True + OnClick = btn_hexcopyClick + end + end + object group_progress: TGroupBox + Left = 160 + Top = 384 + Width = 297 + Height = 57 + Caption = 'Extracting...' + TabOrder = 2 + Visible = False + object lbl_progress: TLabel + Left = 10 + Top = 36 + Width = 279 + Height = 18 + AutoSize = False + end + object progress: TProgressBar + Left = 8 + Top = 16 + Width = 217 + Height = 17 + Step = 1 + TabOrder = 0 + end + object btn_extractcancel: TButton + Left = 232 + Top = 16 + Width = 57 + Height = 33 + Caption = 'Cancel' + TabOrder = 1 + OnClick = btn_extractcancelClick + end + end + object fopen: TOpenDialog + Filter = 'Oni-Dat-Files|*.dat|Oni-Sep-Files (MAC)|*.sep' + Left = 72 + end + object menu: TMainMenu + AutoHotkeys = maManual + Left = 128 + object menu_main: TMenuItem + Caption = 'Main' + object menu_exit: TMenuItem + Caption = 'Exit' + OnClick = menu_exitClick + end + end + object menu_tools: TMenuItem + Caption = 'Tools' + object menu_txmpreplace: TMenuItem + Caption = 'TXMP replacer' + OnClick = menu_txmpreplaceClick + end + end + object menu_preview: TMenuItem + Caption = 'Preview Window' + OnClick = menu_previewClick + end + end +end Index: /oup/releases/0.14a/Unit1_main.pas =================================================================== --- /oup/releases/0.14a/Unit1_main.pas (revision 21) +++ /oup/releases/0.14a/Unit1_main.pas (revision 21) @@ -0,0 +1,383 @@ +UNIT Unit1_main; +INTERFACE +USES + Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, + Dialogs, StdCtrls, StrUtils, Clipbrd, ExtCtrls, ComCtrls, Menus, + Unit2_functions, Unit3_data, Unit5_preview, Unit7_txmpreplace; + +TYPE + TForm1 = Class(TForm) + panel_all: TPanel; + panel_left: TPanel; + Splitter1: TSplitter; + panel_files: TPanel; + btn_extractallconvert: TButton; + btn_extract: TButton; + btn_extractconvert: TButton; + list_files: TListBox; + btn_extractall: TButton; + list_extensions: TListBox; + Splitter2: TSplitter; + panel_right: TPanel; + edit_data: TMemo; + list_names: TListBox; + Splitter3: TSplitter; + panel_info: TPanel; + lbl_info: TLabel; + btn_load: TButton; + btn_hexcopy: TButton; + fopen: TOpenDialog; + lbl_fileinfo: TLabel; + group_progress: TGroupBox; + progress: TProgressBar; + lbl_progress: TLabel; + menu: TMainMenu; + menu_main: TMenuItem; + menu_exit: TMenuItem; + menu_preview: TMenuItem; + btn_extractcancel: TButton; + menu_tools: TMenuItem; + menu_txmpreplace: TMenuItem; + PROCEDURE menu_txmpreplaceClick(Sender: TObject); + PROCEDURE menu_exitClick(Sender: TObject); + PROCEDURE btn_extractcancelClick(Sender: TObject); + PROCEDURE menu_previewClick(Sender: TObject); + PROCEDURE btn_extractallconvertClick(Sender: TObject); + PROCEDURE Splitter2Moved(Sender: TObject); + PROCEDURE Splitter1Moved(Sender: TObject); + PROCEDURE FormClose(Sender: TObject; var Action: TCloseAction); + PROCEDURE btn_hexcopyClick(Sender: TObject); + PROCEDURE list_extensionsClick(Sender: TObject); + PROCEDURE FormResize(Sender: TObject); + PROCEDURE btn_extractconvertClick(Sender: TObject); + PROCEDURE FormCreate(Sender: TObject); + PROCEDURE list_filesDblClick(Sender: TObject); + PROCEDURE btn_loadClick(Sender: TObject); + PRIVATE + PUBLIC + END; + +VAR + Form1: TForm1; + +IMPLEMENTATION +{$R *.dfm} + +PROCEDURE DoAfterLoadOfADat; + VAR + i:LongWord; + txt:Text; + temp4:LongWord; + temp2:Word; + temp1:Byte; + BEGIN + IF NOT DirectoryExists(GetExtractPath) THEN + CreateDir(GetExtractPath); + AssignFile(txt,GetExtractPath+'\___TXMP-FILES___.TXT'); + ReWrite(txt); + FOR i:=0 TO dat_header.Extensions-1 DO BEGIN + IF (dat_extensionsmap[i].Extension[3]='T') AND + (dat_extensionsmap[i].Extension[2]='X') AND + (dat_extensionsmap[i].Extension[1]='M') AND + (dat_extensionsmap[i].Extension[0]='P') THEN BEGIN + WriteLn(txt, FormatNumber(dat_extensionsmap[i].ExtCount,4,'0')+' TXMP-Files'); + Break; + END; + END; + WriteLn(txt,'FileName'+#9+'MipMap'+#9+'Depth'+#9+'ImgX'+#9+'ImgY'+#9+'StoreT'); + FOR i:=0 TO dat_header.Files-1 DO BEGIN + IF dat_files[i].Extension='TXMP' THEN BEGIN + Write(txt,dat_files[i].FileName+#9); + LoadDatFilePart(i,$88,1,@temp1); + Write(txt,IntToHex(temp1,2)+#9); + LoadDatFilePart(i,$89,1,@temp1); + Write(txt,IntToHex(temp1,2)+#9); + LoadDatFilePart(i,$8C,2,@temp2); + Write(txt,IntToHex(temp2,4)+#9); + LoadDatFilePart(i,$8E,2,@temp2); + Write(txt,IntToHex(temp2,4)+#9); + LoadDatFilePart(i,$90,1,@temp1); + Write(txt,IntToHex(temp1,2)+#9); + WriteLn(txt,''); + END; + END; + CloseFile(txt); + + IF NOT DirectoryExists(GetExtractPath) THEN + CreateDir(GetExtractPath); + AssignFile(txt,GetExtractPath+'\___TXAN-FILES___.TXT'); + ReWrite(txt); + FOR i:=0 TO dat_header.Extensions-1 DO BEGIN + IF (dat_extensionsmap[i].Extension[3]='T') AND + (dat_extensionsmap[i].Extension[2]='X') AND + (dat_extensionsmap[i].Extension[1]='A') AND + (dat_extensionsmap[i].Extension[0]='N') THEN BEGIN + WriteLn(txt, FormatNumber(dat_extensionsmap[i].ExtCount,4,'0')+' TXAN-Files'); + Break; + END; + END; + WriteLn(txt,'FileName'+#9+'Loopspeed'+#9+'Unknown'+#9+'Links'); + FOR i:=0 TO dat_header.Files-1 DO BEGIN + IF dat_files[i].Extension='TXAN' THEN BEGIN + Write(txt,dat_files[i].FileName+#9); + LoadDatFilePart(i,$14,2,@temp2); + Write(txt,IntToHex(temp2,4)+#9); + LoadDatFilePart(i,$16,2,@temp2); + Write(txt,IntToHex(temp2,4)+#9); + LoadDatFilePart(i,$1C,4,@temp4); + Write(txt,IntToHex(temp4,8)+#9); + WriteLn(txt,''); + END; + END; + CloseFile(txt); + END; + +PROCEDURE TForm1.btn_loadClick(Sender: TObject); + VAR i:LongWord; + BEGIN + fopen.InitialDir:=AppSettings.DatPath; + IF fopen.Execute THEN BEGIN + Form1.Caption:='Oni Un/Packer '+version+' ('+ExtractFileName(fopen.FileName)+')'; + AppSettings.DatPath:=ExtractFilepath(fopen.FileName); + list_files.Items.Clear; + list_extensions.Items.Clear; + list_names.Items.Clear; + IF LoadDatInfos(fopen.FileName) THEN BEGIN + lbl_info.Caption:= + '# of files: '+IntToStr(dat_header.Files)+CrLf+ + '# of named files: '+IntToStr(dat_header.NamedFiles)+CrLf+ + '# of extensions: '+IntToStr(dat_header.Extensions)+CrLf+ + 'Address of Body: 0x'+IntToHex(dat_header.DataAddr,8)+CrLf+ + 'Address of End: 0x'+IntToHex(dat_header.NamesAddr,8); + list_extensions.Items.Add('_All files: '+FormatNumber(dat_header.Files,4,' ')); + FOR i:=0 TO dat_header.Extensions-1 DO BEGIN + WITH dat_extensionsmap[i] DO BEGIN + list_extensions.Items.Add( + Extension[3]+Extension[2]+Extension[1]+Extension[0]+': '+ + FormatNumber(ExtCount,4,' '));{+' (Ident: 0x'+ + IntToHex(Ident[7],2)+IntToHex(Ident[6],2)+IntToHex(Ident[5],2)+IntToHex(Ident[4],2)+IntToHex(Ident[3],2)+IntToHex(Ident[2],2)+IntToHex(Ident[1],2)+IntToHex(Ident[0],2)+')');} + END; + END; + FOR i:=0 TO dat_header.namedFiles-1 DO BEGIN + WITH dat_namedfilesmap[i] DO BEGIN + list_names.Items.Add('0x'+IntToHex(filenumber,8)+': 0x'+IntToHex(blubb,8)); + END; + END; + Form1.list_extensions.ItemIndex:=0; + Form1.list_extensionsClick(Form1); + Form1.list_files.ItemIndex:=0; + Form1.list_filesDblClick(Form1); + + Form7.RecreateTXMPlist; + + DoAfterLoadOfADat; + + END ELSE BEGIN + ShowMessage('Error while loading the file:'+CrLf+fopen.FileName+CrLf+'Perhaps not an Oni-.dat-file?'); + END; + END; + END; + +PROCEDURE TForm1.list_filesDblClick(Sender: TObject); + VAR + id:LongWord; + temp:Tdata; + BEGIN + id:=StrToInt(MidStr(list_files.Items.Strings[list_files.ItemIndex],1,5)); + lbl_fileinfo.Caption:= + 'Filename: '+dat_files[id].FileName+CrLf+ + 'Size: '+FormatFileSize(dat_files[id].Size)+' ('+IntToStr(dat_files[id].Size)+' Bytes)'+CrLf+ + 'FileType: 0x'+IntToHex(dat_files[id].FileType,8)+CrLf+ + 'Address in .dat: 0x'+IntTohex(dat_files[id].DatAddr,8); + IF (dat_files[id].FileType AND $02)=0 THEN BEGIN + temp:=LoadDatFile(id); + edit_data.Text:=CreateHexString(temp,False); + btn_hexcopy.Visible:=True; + IF Form5.Visible THEN Form5.ShowPreview(id); + END ELSE BEGIN + edit_data.Text:='Zero byte file.'+CrLf+'Oni will take the data for this file of level0_final.dat/raw'; + btn_hexcopy.Visible:=False; + END; + END; + +PROCEDURE TForm1.FormCreate(Sender: TObject); + BEGIN + Form1.Caption:='Oni Un/Packer '+version; + Form1.FormResize(Form1); + + panel_all.Align:=alClient; + + IF FileExists(ExtractFilepath(Application.EXEname)+'\oniunpacker.ini') THEN BEGIN + AssignFile(AppSettingsFile,ExtractFilepath(Application.EXEname)+'\oniunpacker.ini'); + Reset(AppSettingsFile); + Read(AppSettingsFile,AppSettings); + CloseFile(AppSettingsFile); + END ELSE BEGIN + AppSettings.DatPath:='D:\Spiele\Oni\GameDataFolder'; + AppSettings.ExtractPath:='C:\Dokumente und Einstellungen\Administrator\Desktop'; + END; + + //Form1.btn_loadClick(Form1); + END; + +PROCEDURE TForm1.btn_extractconvertClick(Sender: TObject); + VAR + result:Integer; + id:LongWord; + BEGIN + id:=StrToInt(MidStr(list_files.Items.Strings[list_files.ItemIndex],1,5)); + IF TComponent(Sender).Name='btn_extract' THEN + result:=ExportFile(id,False) + ELSE + result:=ExportFile(id,True); + CASE result OF + 0{export_noerror}: IF 1=2 THEN BEGIN END; + 1{export_nohandler}: ShowMessage('No export-handler for files with extension '+dat_files[id].Extension+'.'); + 2{export_handlererror}: ShowMessage('Error while running data-handler for '+CrLf+dat_files[id].FileName); + 3{export_error}: ShowMessage('Error while exporting file '+CrLf+dat_files[id].FileName); + ELSE ShowMessage('Couldn''t export file '+FormatNumber(id,5,'0')+CrLf+'(Unknown error)'); + END; + Form1.list_files.SetFocus; + END; + +PROCEDURE TForm1.FormResize(Sender: TObject); + CONST + MinWidth:Integer=750; + MinHeight:Integer=500; + BEGIN + IF NOT group_progress.Visible THEN BEGIN + IF Form1.Width0 THEN Inc(errors); + IF (i MOD 25)=0 THEN BEGIN + lbl_progress.Caption:=IntToStr(i)+'/'+IntToStr(dat_header.Files); + progress.Position:=i; + Application.ProcessMessages; + IF btn_extractcancel.Caption='Cancel_' THEN BEGIN + btn_extractcancel.Caption:='Cancel'; + Break; + END; + END; + END; + IF errors>0 THEN + ShowMessage(IntToStr(errors)+' errors encountered.'); + + Form1.Width:=oldwidth; + Form1.Height:=oldheight; + Form1.WindowState:=oldstate; + //FOR i:=0 TO menu.ComponentCount DO menu.Items.Items[i].Enabled:=True; + panel_all.Visible:=True; + panel_info.Visible:=True; + group_progress.Visible:=False; + END; + +PROCEDURE TForm1.menu_previewClick(Sender: TObject); + BEGIN + Form5.Visible:=NOT Form5.Visible; + END; + +PROCEDURE TForm1.btn_extractcancelClick(Sender: TObject); + BEGIN + btn_extractcancel.Caption:='Cancel_'; + END; + +PROCEDURE TForm1.menu_exitClick(Sender: TObject); + BEGIN + Form1.Close; + END; + +PROCEDURE TForm1.menu_txmpreplaceClick(Sender: TObject); + BEGIN + Form7.Visible:=NOT Form7.Visible; + END; + +END. Index: /oup/releases/0.14a/Unit2_functions.pas =================================================================== --- /oup/releases/0.14a/Unit2_functions.pas (revision 21) +++ /oup/releases/0.14a/Unit2_functions.pas (revision 21) @@ -0,0 +1,205 @@ +UNIT Unit2_functions; +INTERFACE +USES Classes, SysUtils, StrUtils, Math, SQLiteTable3, Unit3_data, Unit4_Exporters; + +FUNCTION LoadDatInfos(filename:String):Boolean; +FUNCTION LoadDatFile(fileid:LongWord):Tdata; +FUNCTION LoadDatFilePart(fileid,offset,size:LongWord; target:Pointer):Boolean; +FUNCTION LoadRawFilePart(address,size:LongWord; target:Pointer):Boolean; +FUNCTION FormatNumber(value:LongWord; width:Byte; leadingzeros:Char):String; +FUNCTION FormatFileSize(size:LongWord):String; +FUNCTION CreateHexString(data:Tdata; HexOnly:Boolean):String; +FUNCTION ExportFile(fileid:LongWord; convert:Boolean):Integer; +FUNCTION GetWinFileName(fileid:LongWord; substring:String):String; +FUNCTION GetExtractPath:String; + + + +IMPLEMENTATION + + +FUNCTION LoadDatInfos(filename:String):Boolean; + VAR i:LongWord; + dat_file:TFileStream; + BEGIN + Result:=True; + dat_filename:=filename; + raw_filename:=MidStr(filename,1,Length(filename)-3)+'raw'; + dat_file:=TFileStream.Create(filename, fmOpenRead); + dat_file.Read(dat_header,SizeOf(dat_header)); + FOR i:=0 TO High(dat_header.Ident) DO + IF dat_header.Ident[i]<>header_ident1[i] THEN BEGIN + Result:=False; + Exit; + END; +{ FOR i:=0 TO High(dat_header.Ident2) DO + IF dat_header.Ident2[i]<>header_ident2[i] THEN BEGIN + Result:=False; + Exit; + END; +} + SetLength(dat_filesmap,dat_header.Files); + SetLength(dat_files,dat_header.Files); + FOR i:=0 TO dat_header.Files-1 DO dat_file.Read(dat_filesmap[i],SizeOf(dat_filesmap[i])); + FOR i:=0 TO dat_header.Files-1 DO BEGIN + dat_files[i].Extension:=dat_filesmap[i].Extension; + dat_files[i].Extension:=ReverseString(dat_files[i].Extension); + dat_files[i].Size:=dat_filesmap[i].FileSize; + dat_files[i].FileType:=dat_filesmap[i].FileType; + dat_files[i].DatAddr:=dat_filesmap[i].DataAddr-8+dat_header.DataAddr; + IF (dat_filesmap[i].FileType AND $01)=0 THEN BEGIN + dat_file.Seek(dat_filesmap[i].NameAddr+dat_header.NamesAddr,soFromBeginning); + SetLength(dat_files[i].Name,100); + dat_file.Read(dat_files[i].Name[1],100); + dat_files[i].Name:=MidStr(dat_files[i].Name,1+4,Pos(#0,dat_files[i].Name)-1-4); + END ELSE BEGIN + dat_files[i].Name:=''; + END; + dat_files[i].FileName:=FormatNumber(i,5,'0')+'-'+dat_files[i].Name+'.'+dat_files[i].Extension; + END; + dat_file.Seek($40+dat_header.Files*$14,soFromBeginning); + SetLength(dat_namedfilesmap,dat_header.NamedFiles); + FOR i:=0 TO dat_header.NamedFiles-1 DO dat_file.Read(dat_namedfilesmap[i],SizeOf(dat_namedfilesmap[i])); + + dat_file.Seek($40+dat_header.Files*$14+dat_header.NamedFiles*$8,soFromBeginning); + SetLength(dat_extensionsmap,dat_header.Extensions); + FOR i:=0 TO dat_header.Extensions-1 DO dat_file.Read(dat_extensionsmap[i],SizeOf(dat_extensionsmap[i])); + + dat_file.Free; + END; + + +FUNCTION LoadDatFile(fileid:LongWord):Tdata; + VAR dat_file:TFileStream; + BEGIN + dat_file:=TFileStream.Create(dat_filename, fmOpenRead); + dat_file.Seek(dat_files[fileid].DatAddr,soFromBeginning); + SetLength(Result,dat_files[fileid].Size); + dat_file.Read(Result[0],dat_files[fileid].Size); + dat_file.Free; + END; + + +FUNCTION LoadDatFilePart(fileid,offset,size:LongWord; target:Pointer):Boolean; + VAR dat_file:TFileStream; + BEGIN + dat_file:=TFileStream.Create(dat_filename, fmOpenRead); + Result:=True; + dat_file.Seek(dat_files[fileid].DatAddr+offset,soFromBeginning); + dat_file.Read(target^,size); + dat_file.Free; + END; + + +FUNCTION LoadRawFilePart(address,size:LongWord; target:Pointer):Boolean; + VAR + filestream:TFileStream; + BEGIN + Result:=True; + filestream:=TFileStream.Create(AnsiReplaceStr(dat_filename,'.dat','.raw'),fmOpenRead); + filestream.Seek(address,soFromBeginning); + filestream.Read(target^,size); + filestream.Free; + END; + + +FUNCTION FormatNumber(value:LongWord; width:Byte; leadingzeros:Char):String; + BEGIN + Result:=AnsiReplaceStr(Format('%'+IntToStr(width)+'u',[value]),' ',leadingzeros); + END; + + +FUNCTION FormatFileSize(size:LongWord):String; + BEGIN + IF size>=1024*1024*1024 THEN BEGIN + Result:=FloatToStrF(size/1024/1024/1024,ffFixed,5,1)+' GB'; + END ELSE BEGIN + IF size>=1024*1024 THEN BEGIN + Result:=FloatToStrF(size/1024/1024,ffFixed,5,1)+' MB'; + END ELSE BEGIN + IF size>=1024 THEN BEGIN + Result:=FloatToStrF(size/1024,ffFixed,5,1)+' KB'; + END ELSE BEGIN + Result:=IntToStr(size)+' B'; + END; + END; + END; + END; + + +FUNCTION CreateHexString(data:Tdata; HexOnly:Boolean):String; + VAR + string_build,ascii_version:String; + i:LongWord; + BEGIN + string_build:=''; + ascii_version:=''; + FOR i:=0 TO High(data) DO BEGIN + IF NOT HexOnly THEN + IF (i MOD 16)=0 THEN + string_build:=string_build+'0x'+IntToHex(i,6)+' '; + string_build:=string_build+IntToHex(data[i],2); + IF NOT HexOnly THEN BEGIN + IF data[i]>=32 THEN ascii_version:=ascii_version+Chr(data[i]) + ELSE ascii_version:=ascii_version+'.'; + IF ((i+1) MOD 2)=0 THEN string_build:=string_build+#32; + IF ((i+1) MOD 16)=0 THEN BEGIN + string_build:=string_build+#32+ascii_version+CrLf; + ascii_version:=''; + END; + END; + END; + Result:=string_build; + END; + + +FUNCTION ExportFile(fileid:LongWord; convert:Boolean):Integer; + VAR + i:Byte; + BEGIN + Result:=export_noerror; + + //ExportDefFileHeader(fileid); + + IF (dat_files[fileid].FileType AND $02)=0 THEN BEGIN + //ExportDatFile(fileid); + + FOR i:=1 TO Length(ExportHandlers)+1 DO BEGIN + IF i<=Length(ExportHandlers) THEN BEGIN + IF ExportHandlers[i].Ext=dat_files[fileid].Extension THEN BEGIN + IF ExportHandlers[i].needed THEN BEGIN + CASE ExportHandlers[i].Handler(fileid,convert) OF + 0: Result:=0; + ELSE + Result:=export_handlererror; + END; + END; + Break; + END; + END ELSE BEGIN + Result:=export_nohandler; + END; + END; + END; + END; + + +FUNCTION GetWinFileName(fileid:LongWord; substring:String):String; + VAR + name:String; + BEGIN + name:=dat_files[fileid].Name; + name:=AnsiReplaceStr(name,'\','__'); + name:=AnsiReplaceStr(name,'/','__'); + name:=AnsiReplaceStr(name,'>','__'); + name:=AnsiReplaceStr(name,'<','__'); + Result:=FormatNumber(fileid,5,'0')+'-'+name+'.'+substring+'.'+dat_files[fileid].Extension; + END; + +FUNCTION GetExtractPath:String; + BEGIN + Result:=ExtractFilePath(dat_filename)+'\extracted_'+ExtractFileName(dat_filename); + END; + + +END. Index: /oup/releases/0.14a/Unit3_data.pas =================================================================== --- /oup/releases/0.14a/Unit3_data.pas (revision 21) +++ /oup/releases/0.14a/Unit3_data.pas (revision 21) @@ -0,0 +1,84 @@ +UNIT Unit3_data; +INTERFACE +USES Classes; + +CONST + version:String='v0.14a'; + CrLf:String[2]=#13+#10; + +TYPE + Tdata=Array OF Byte; + Theader=PACKED RECORD + Ident:Array[0..$13] OF Byte; + Files:LongWord; + NamedFiles:LongWord; + Extensions:LongWord; + DataAddr:LongWord; + DataSize:LongWord; + NamesAddr:LongWord; + NamesSize:LongWord; + Ident2:Array[0..$F] OF Byte; + END; + Tfilesmap=Array OF PACKED RECORD + Extension:Array[0..$3] OF Char; + DataAddr:LongWord; + NameAddr:LongWord; + FileSize:LongWord; + FileType:LongWord; + END; + Tfiles=Array OF PACKED RECORD + FileName:String; + Extension:String[4]; + Name:String; + Size:LongWord; + FileType:LongWord; + DatAddr:LongWord; + END; + + Tnamedfilesmap=Array OF PACKED RECORD + FileNumber:LongWord; + blubb:LongWord; + END; + Textensionsmap=Array OF PACKED RECORD + Ident:Array[0..$7] OF Byte; + Extension:Array[0..$3] OF Char; + ExtCount:LongWord; + END; + + TAppSettings=RECORD + DatPath:String[250]; + ExtractPath:String[250]; + END; + + TExportHandlers=RECORD + Ext:String[4]; + needed:Boolean; + Handler:Function(fileid:LongWord; convert:Boolean):Integer; + END; + +VAR + dat_filename:String=''; + raw_filename:String=''; + dat_header:Theader; + dat_filesmap:Tfilesmap; + dat_files:Tfiles; + dat_namedfilesmap:Tnamedfilesmap; + dat_extensionsmap:Textensionsmap; + AppSettings:TAppSettings; + AppSettingsFile:File OF TAppSettings; + +CONST + header_ident1:Array[0..$13] OF Byte= + ($1F,$27,$DC,$33,$DF,$BC,$03,$00,$31,$33,$52,$56,$40,$00,$14,$00,$10,$00,$08,$00); + header_ident2:Array[0..$F] OF Byte= + ($99,$CF,$40,$00,$90,$4F,$63,$00,$F4,$55,$5F,$00,$90,$4F,$63,$00); + + export_noerror:Integer=0; + export_nohandler:Integer=1; + export_handlererror:Integer=2; + export_error:Integer=3; + +IMPLEMENTATION + +END. + Index: /oup/releases/0.14a/Unit4_Exporters.pas =================================================================== --- /oup/releases/0.14a/Unit4_Exporters.pas (revision 21) +++ /oup/releases/0.14a/Unit4_Exporters.pas (revision 21) @@ -0,0 +1,181 @@ +UNIT Unit4_Exporters; +INTERFACE +USES Classes, StrUtils, SysUtils, Math, Unit3_data, Unit6_imgfuncs; + +PROCEDURE ExportDefLine(fileid:LongWord; line:String; create:Boolean); +PROCEDURE ExportDefFileHeader(fileid:LongWord); +PROCEDURE ExportDatFile(fileid:LongWord); + +FUNCTION ExportTRAC(fileid:LongWord; convert:Boolean):Integer; +FUNCTION ExportTXAN(fileid:LongWord; convert:Boolean):Integer; +FUNCTION ExportTXMB(fileid:LongWord; convert:Boolean):Integer; +FUNCTION ExportTXMP(fileid:LongWord; convert:Boolean):Integer; +VAR + ExportHandlers:Array[1..5] OF TExportHandlers=( + (Ext:'ABNA'; needed:False), + //(Ext:'AGDB'; needed:False), + (Ext:'TRAC'; needed:True; Handler:ExportTRAC), + (Ext:'TXAN'; needed:True; Handler:ExportTXAN), + (Ext:'TXMB'; needed:True; Handler:ExportTXMB), + (Ext:'TXMP'; needed:True; Handler:ExportTXMP) + ); + + + +IMPLEMENTATION +USES Unit2_functions; + +PROCEDURE ExportDefLine(fileid:LongWord; line:String; create:Boolean); + VAR + filestream:TFileStream; + data:Tdata; + i:LongWord; + BEGIN + SetLength(data,Length(line)+2); + FOR i:=1 TO Length(line) DO + data[i-1]:=Ord(line[i]); + data[Length(line)]:=13; + data[Length(line)+1]:=10; + { + IF create THEN + filestream:=TFileStream.Create(GetExtractPath+'\'+GetWinFileName(fileid,'_DEF_'),fmCreate) + ELSE BEGIN + filestream:=TFileStream.Create(GetExtractPath+'\'+GetWinFileName(fileid,'_DEF_'),fmOpenWrite); + filestream.Seek(0,soFromEnd); + END; + filestream.Write(data[0],Length(data)); + filestream.Free; + } + END; + +PROCEDURE ExportDefFileHeader(fileid:LongWord); + BEGIN + IF NOT DirectoryExists(GetExtractPath) THEN + CreateDir(GetExtractPath); + WITH dat_files[fileid] DO + ExportDefLine(fileid,FormatNumber(fileid,5,'0')+':'+Name+':'+Extension+':'+IntToHex(Size,8)+':'+IntToHex(FileType,8),True); + END; + +PROCEDURE ExportDatFile(fileid:LongWord); + VAR + filestream:TFileStream; + data:Tdata; + BEGIN + data:=LoadDatFile(fileid); + filestream:=TFileStream.Create(GetExtractPath+'\'+GetWinFileName(fileid,'_DAT_'),fmCreate); + filestream.Write(data[0],Length(data)); + filestream.Free; + END; + + +FUNCTION ExportTRAC; + VAR + link:LongWord; + linkcount:Word; + i:LongWord; + BEGIN + Result:=export_noerror; + + LoadDatFilePart(fileid,$18,SizeOf(link),@link); + link:=link DIV 256; + ExportDefLine(fileid,FormatNumber(0,4,'0')+':LINKtoTRAC:'+FormatNumber(link,5,'0')+':'+dat_files[link].Name+':'+dat_files[link].Extension,False); + + LoadDatFilePart(fileid,$1E,SizeOf(linkcount),@linkcount); + ExportDefLine(fileid,'TRAMLINKS:'+FormatNumber(linkcount,4,'0'),False); + FOR i:=1 TO linkcount DO BEGIN + LoadDatFilePart(fileid,$20+(i-1)*12+8,SizeOf(link),@link); + link:=link DIV 256; + ExportDefLine(fileid,FormatNumber(i,4,'0')+':LINKtoTRAM:'+FormatNumber(link,5,'0')+':'+dat_files[link].Name+':'+dat_files[link].Extension,False); + END; + END; + +FUNCTION ExportTXAN; + VAR + loop_speed,unknown:Word; + linkcount:LongWord; + link:LongWord; + i:Byte; + BEGIN + Result:=export_noerror; + + LoadDatFilePart(fileid,$14,SizeOf(loop_speed),@loop_speed); + LoadDatFilePart(fileid,$16,SizeOf(unknown),@unknown); + ExportDefLine(fileid,'LOOPSPEED:'+FormatNumber(loop_speed,2,'0'),False); + ExportDefLine(fileid,'UNKNOWN:'+FormatNumber(unknown,2,'0'),False); + + LoadDatFilePart(fileid,$1C,SizeOf(linkcount),@linkcount); + ExportDefLine(fileid,'TXMPLINKS:'+FormatNumber(linkcount,4,'0'),False); + FOR i:=0 TO linkcount-1 DO BEGIN + LoadDatFilePart(fileid,$20+i*4,SizeOf(link),@link); + link:=link DIV 256; + IF link=0 THEN link:=fileid-1; + ExportDefLine(fileid,FormatNumber(i,4,'0')+':LINKtoTXMP:'+FormatNumber(link,5,'0')+':'+dat_files[link].Name+':'+dat_files[link].Extension,False); + END; + END; + +FUNCTION ExportTXMB; + VAR + filestream:TFileStream; + subfile:Byte; + linkcount:LongWord; + link:LongWord; + width,height:Word; + cols,rows:Word; + i:Byte; + img:TImgPackage; + data:Tdata; + BEGIN + Result:=export_noerror; + subfile:=1; + + LoadDatFilePart(fileid,$10,SizeOf(width),@width); + LoadDatFilePart(fileid,$12,SizeOf(height),@height); + LoadDatFilePart(fileid,$18,SizeOf(cols),@cols); + LoadDatFilePart(fileid,$1A,SizeOf(rows),@rows); + ExportDefLine(fileid,'WIDTH:'+FormatNumber(width,4,'0'),False); + ExportDefLine(fileid,'HEIGHT:'+FormatNumber(height,4,'0'),False); + ExportDefLine(fileid,'COLS:'+FormatNumber(cols,2,'0'),False); + ExportDefLine(fileid,'ROWS:'+FormatNumber(rows,2,'0'),False); + + LoadDatFilePart(fileid,$1C,SizeOf(linkcount),@linkcount); + ExportDefLine(fileid,'TXMPLINKS:'+FormatNumber(linkcount,4,'0'),False); + FOR i:=0 TO linkcount-1 DO BEGIN + LoadDatFilePart(fileid,$20+i*4,SizeOf(link),@link); + link:=link DIV 256; + IF link=0 THEN link:=fileid-1; + ExportDefLine(fileid,FormatNumber(i,4,'0')+':LINKtoTXMP:'+FormatNumber(link,5,'0')+':'+dat_files[link].Name+':'+dat_files[link].Extension,False); + END; + + IF convert THEN BEGIN + img:=LoadTXMBconnected(fileid); + data:=ImgdataToBmp(img.imgx,img.imgy,img.imgdepth,img.storetype,img.imgdata); + filestream:=TFileStream.Create(GetExtractPath+'\'+GetWinFileName(fileid,FormatNumber(subfile,2,'0')+'-ImgData')+'.bmp',fmCreate); + filestream.Write(data[0],Length(data)); + filestream.Free; + END; + END; + +FUNCTION ExportTXMP; + VAR + filestream:TFileStream; + subfile:Byte; + img:TImgPackage; + BEGIN + Result:=export_noerror; + subfile:=1; + + img:=LoadImgData(fileid); + { + filestream:=TFileStream.Create(GetExtractPath+'\'+GetWinFileName(fileid,FormatNumber(subfile,2,'0')+'-ImgData'),fmCreate); + filestream.Write(img.imgdata[0],Length(img.imgdata)); + filestream.Free; + } + IF convert THEN BEGIN + img.imgdata:=ImgdataToBMP(img.imgx,img.imgy,img.imgdepth,img.storetype,img.imgdata); + filestream:=TFileStream.Create(GetExtractPath+'\'+GetWinFileName(fileid,FormatNumber(subfile,2,'0')+'-ImgData')+'.bmp',fmCreate); + filestream.Write(img.imgdata[0],Length(img.imgdata)); + filestream.Free; + END; + END; + +END. Index: /oup/releases/0.14a/Unit5_preview.dfm =================================================================== --- /oup/releases/0.14a/Unit5_preview.dfm (revision 21) +++ /oup/releases/0.14a/Unit5_preview.dfm (revision 21) @@ -0,0 +1,74 @@ +object Form5: TForm5 + Left = 0 + Top = 0 + Width = 435 + Height = 348 + BorderStyle = bsSizeToolWin + Caption = 'Preview' + Color = clBtnFace + Font.Charset = DEFAULT_CHARSET + Font.Color = clWindowText + Font.Height = -11 + Font.Name = 'Tahoma' + Font.Style = [] + FormStyle = fsStayOnTop + OldCreateOrder = False + OnCloseQuery = FormCloseQuery + OnCreate = FormCreate + OnResize = FormResize + PixelsPerInch = 96 + TextHeight = 13 + object img: TImage + Left = 0 + Top = 20 + Width = 427 + Height = 304 + Align = alClient + end + object panel_buttons: TPanel + Left = 0 + Top = 0 + Width = 427 + Height = 20 + Align = alTop + BevelOuter = bvNone + TabOrder = 0 + Visible = False + OnResize = panel_buttonsResize + object btn_dec: TButton + Left = 0 + Top = 0 + Width = 20 + Height = 20 + Caption = '-' + Enabled = False + TabOrder = 0 + OnClick = btn_decClick + end + object btn_startstop: TButton + Left = 21 + Top = 0 + Width = 80 + Height = 20 + Caption = 'Stop automatic' + TabOrder = 1 + OnClick = btn_startstopClick + end + object btn_inc: TButton + Left = 102 + Top = 0 + Width = 20 + Height = 20 + Caption = '+' + Enabled = False + TabOrder = 2 + OnClick = btn_incClick + end + end + object timer: TTimer + Enabled = False + OnTimer = timerTimer + Left = 72 + Top = 48 + end +end Index: /oup/releases/0.14a/Unit5_preview.pas =================================================================== --- /oup/releases/0.14a/Unit5_preview.pas (revision 21) +++ /oup/releases/0.14a/Unit5_preview.pas (revision 21) @@ -0,0 +1,183 @@ +UNIT Unit5_preview; +INTERFACE +USES + Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, + Dialogs, Math, ExtCtrls, Unit2_functions, Unit3_data, Unit4_exporters, Unit6_imgfuncs, + StdCtrls; + +TYPE + TForm5 = Class(TForm) + img: TImage; + timer: TTimer; + panel_buttons: TPanel; + btn_dec: TButton; + btn_startstop: TButton; + btn_inc: TButton; + PROCEDURE btn_incClick(Sender: TObject); + PROCEDURE btn_decClick(Sender: TObject); + PROCEDURE FormResize(Sender: TObject); + PROCEDURE btn_startstopClick(Sender: TObject); + PROCEDURE panel_buttonsResize(Sender: TObject); + PROCEDURE timerTimer(Sender: TObject); + PROCEDURE FormCreate(Sender: TObject); + PROCEDURE FormCloseQuery(Sender: TObject; var CanClose: Boolean); + PROCEDURE ShowPreview(fileid:LongWord); + PRIVATE + PUBLIC + END; + +VAR + Form5: TForm5; + +IMPLEMENTATION +{$R *.dfm} +USES Unit1_main; +VAR + memstreams:Array OF TMemoryStream; + actualimg:Byte; + _fileid:LongWord; + +PROCEDURE PreviewTXMB; + VAR + data:Tdata; + img:TImgPackage; + BEGIN + SetLength(memstreams,1); + img:=LoadTXMBconnected(_fileid); + data:=ImgdataToBmp(img.imgx,img.imgy,img.imgdepth,img.storetype,img.imgdata); + + memstreams[0].Clear; + memstreams[0].Write(data[0],Length(data)); + memstreams[0].Seek(0,soFromBeginning); + + Form5.img.Picture.Bitmap.LoadFromStream(memstreams[0]); + END; + +PROCEDURE PreviewTXMP; + VAR + data:Tdata; + img:TImgPackage; + BEGIN + SetLength(memstreams,1); + img:=LoadImgData(_fileid); + data:=ImgdataToBmp(img.imgx,img.imgy,img.imgdepth,img.storetype,img.imgdata); + + memstreams[0].Clear; + memstreams[0].Write(data[0],Length(data)); + memstreams[0].Seek(0,soFromBeginning); + + Form5.img.Picture.Bitmap.LoadFromStream(memstreams[0]); + END; + +PROCEDURE PreviewTXAN; + VAR + loop_speed:Word; + linkcount:LongWord; + link:LongWord; + i:Byte; + data:Tdata; + img:TImgPackage; + BEGIN + LoadDatFilePart(_fileid,$14,SizeOf(loop_speed),@loop_speed); + LoadDatFilePart(_fileid,$1C,SizeOf(linkcount),@linkcount); + SetLength(memstreams,linkcount); + FOR i:=0 TO linkcount-1 DO BEGIN + LoadDatFilePart(_fileid,$20+i*4,SizeOf(link),@link); + link:=link DIV 256; + IF link=0 THEN link:=_fileid-1; + memstreams[i]:=TMemoryStream.Create; + img:=LoadImgData(link); + data:=ImgdataToBmp(img.imgx,img.imgy,img.imgdepth,img.storetype,img.imgdata); + memstreams[i].Clear; + memstreams[i].Write(data[0],Length(data)); + memstreams[i].Seek(0,soFromBeginning); + END; + actualimg:=254; + Form5.timer.Interval:=Floor(loop_speed*(1/60)*1000); + Form5.timer.Enabled:=False; + Form5.btn_startstopClick(Form5); + Form5.panel_buttons.Visible:=True; + END; + +PROCEDURE TForm5.ShowPreview(fileid:LongWord); + BEGIN + _fileid:=fileid; + Form5.timer.Enabled:=False; + Form5.panel_buttons.Visible:=False; + Form5.Caption:='Preview '+dat_files[_fileid].FileName; + IF dat_files[fileid].Extension='TXAN' THEN PreviewTXAN; + IF dat_files[fileid].Extension='TXMB' THEN PreviewTXMB; + IF dat_files[fileid].Extension='TXMP' THEN PreviewTXMP; + END; + +PROCEDURE TForm5.FormCloseQuery(Sender: TObject; var CanClose: Boolean); + BEGIN + CanClose:=False; + Form5.Visible:=False; + END; + +PROCEDURE TForm5.FormCreate(Sender: TObject); + BEGIN + SetLength(memstreams,1); + memstreams[0]:=TMemoryStream.Create; + Form5.Width:=170; + Form5.Height:=200; + END; + +PROCEDURE TForm5.timerTimer(Sender: TObject); + BEGIN + Inc(actualimg); + IF actualimg>=Length(memstreams) THEN actualimg:=0; + Form5.img.Picture.Bitmap.LoadFromStream(memstreams[actualimg]); + memstreams[actualimg].Seek(0,soFromBeginning); + Form5.Caption:='Preview '+dat_files[_fileid].FileName+' ('+IntToStr(actualimg+1)+'/'+IntToStr(Length(memstreams))+')'; + END; + +PROCEDURE TForm5.panel_buttonsResize(Sender: TObject); + BEGIN + btn_startstop.Width:=panel_buttons.Width-45; + btn_inc.Left:=panel_buttons.Width-23; + END; + +PROCEDURE TForm5.btn_startstopClick(Sender: TObject); + BEGIN + Form5.timer.Enabled:=NOT Form5.timer.Enabled; + Form5.btn_dec.Enabled:=NOT Form5.timer.Enabled; + Form5.btn_inc.Enabled:=NOT Form5.timer.Enabled; + IF Form5.timer.Enabled THEN + Form5.btn_startstop.Caption:='Stop automatic' + ELSE + Form5.btn_startstop.Caption:='Start automatic'; + END; + +PROCEDURE TForm5.FormResize(Sender: TObject); + BEGIN + IF Form5.Width>=150 THEN BEGIN + END ELSE Form5.Width:=150; + IF Form5.Height>=150 THEN BEGIN + END ELSE Form5.Height:=150; + END; + +PROCEDURE TForm5.btn_decClick(Sender: TObject); + BEGIN + IF actualimg>0 THEN + Dec(actualimg) + ELSE + actualimg:=High(memstreams); + Form5.Caption:='Preview '+dat_files[_fileid].FileName+' ('+IntToStr(actualimg+1)+'/'+IntToStr(Length(memstreams))+')'; + Form5.img.Picture.Bitmap.LoadFromStream(memstreams[actualimg]); + memstreams[actualimg].Seek(0,soFromBeginning); + END; + +PROCEDURE TForm5.btn_incClick(Sender: TObject); + BEGIN + IF actualimg0) THEN BEGIN + Inc(row_orig); + IF (row_orig MOD 2)=0 THEN BEGIN + Inc(row); + col:=0; + END; + END; + IF (row_orig MOD 2)=0 THEN BEGIN + IF (i MOD 2)=0 THEN BEGIN + FOR j:=0 TO (imgdepth DIV 8)-1 DO + temparray[((row*(oldx DIV 2))+col)*(imgdepth DIV 8)+j]:=data[i*2+j]; + Inc(col); + END; + END; + END; + Result:=temparray; + END; + + +FUNCTION RevertImage(imgx,imgy,imgdepth:LongWord; imgdata:Tdata):Tdata; + VAR + x,y,i:LongWord; + BEGIN + SetLength(Result,imgx*imgy*(imgdepth DIV 8)); + FOR y:=0 TO imgy-1 DO + FOR x:=0 TO imgx-1 DO + FOR i:=0 TO (imgdepth DIV 8)-1 DO + Result[((imgx*(imgy-1-y)+x)*(imgdepth DIV 8))+i]:= + imgdata[(imgx*y+x)*(imgdepth DIV 8)+i]; + END; + + +FUNCTION DecompressImage(imgx,imgy:LongWord; imgdata:Tdata):Tdata; + TYPE + Tcolor=RECORD + RGBb:Byte; + RGBg:Byte; + RGBr:Byte; + RGBa:Byte; + END; + VAR + i,j,x,y:LongWord; + color:Array[1..4] OF Tcolor; + pixel:Array[1..16] OF Byte; + BEGIN + x:=0; + y:=0; + SetLength(Result,imgx*imgy*4); + FOR i:=0 TO ((imgx*imgy) DIV 16)-1 DO BEGIN + Color[1].RGBb:=Floor(((imgdata[(i*8)+0]+imgdata[(i*8)+1]*256) AND $001F) / $001F * 255); + Color[1].RGBg:=Floor(((imgdata[(i*8)+0]+imgdata[(i*8)+1]*256) AND $07E0) / $07E0 * 255); + Color[1].RGBr:=Floor(((imgdata[(i*8)+0]+imgdata[(i*8)+1]*256) AND $F800) / $F800 * 255); + Color[1].RGBa:=255; + Color[2].RGBb:=Floor(((imgdata[(i*8)+2]+imgdata[(i*8)+3]*256) AND $001F) / $001F * 255); + Color[2].RGBg:=Floor(((imgdata[(i*8)+2]+imgdata[(i*8)+3]*256) AND $07E0) / $07E0 * 255); + Color[2].RGBr:=Floor(((imgdata[(i*8)+2]+imgdata[(i*8)+3]*256) AND $F800) / $F800 * 255); + Color[2].RGBa:=255; + Color[3].RGBb:=Floor( Color[1].RGBb/3*2 + Color[2].RGBb/3 ); + Color[3].RGBg:=Floor( Color[1].RGBg/3*2 + Color[2].RGBg/3 ); + Color[3].RGBr:=Floor( Color[1].RGBr/3*2 + Color[2].RGBr/3 ); + Color[3].RGBa:=255; + Color[4].RGBb:=Floor( Color[1].RGBb/3 + Color[2].RGBb/3*2 ); + Color[4].RGBg:=Floor( Color[1].RGBg/3 + Color[2].RGBg/3*2 ); + Color[4].RGBr:=Floor( Color[1].RGBr/3 + Color[2].RGBr/3*2 ); + Color[4].RGBa:=255; + Pixel[1]:=Floor( (imgdata[(i*8)+4] AND $C0) / $40 + 1 ); + Pixel[2]:=Floor( (imgdata[(i*8)+4] AND $30) / $10 + 1 ); + Pixel[3]:=Floor( (imgdata[(i*8)+4] AND $0C) / $04 + 1 ); + Pixel[4]:=Floor( (imgdata[(i*8)+4] AND $03) + 1 ); + Pixel[5]:=Floor( (imgdata[(i*8)+5] AND $C0) / $40 + 1 ); + Pixel[6]:=Floor( (imgdata[(i*8)+5] AND $30) / $10 + 1 ); + Pixel[7]:=Floor( (imgdata[(i*8)+5] AND $0C) / $04 + 1 ); + Pixel[8]:=Floor( (imgdata[(i*8)+5] AND $03) + 1 ); + Pixel[9]:=Floor( (imgdata[(i*8)+6] AND $C0) / $40 + 1 ); + Pixel[10]:=Floor( (imgdata[(i*8)+6] AND $30) / $10 + 1 ); + Pixel[11]:=Floor( (imgdata[(i*8)+6] AND $0C) / $04 + 1 ); + Pixel[12]:=Floor( (imgdata[(i*8)+6] AND $03) + 1 ); + Pixel[13]:=Floor( (imgdata[(i*8)+7] AND $C0) / $40 + 1 ); + Pixel[14]:=Floor( (imgdata[(i*8)+7] AND $30) / $10 + 1 ); + Pixel[15]:=Floor( (imgdata[(i*8)+7] AND $0C) / $04 + 1 ); + Pixel[16]:=Floor( (imgdata[(i*8)+7] AND $03) + 1 ); + FOR j:=0 TO 3 DO BEGIN + Result[((y+3)*imgx+x+j)*3+0]:=Color[Pixel[16-j]].RGBb; + Result[((y+3)*imgx+x+j)*3+1]:=Color[Pixel[16-j]].RGBg; + Result[((y+3)*imgx+x+j)*3+2]:=Color[Pixel[16-j]].RGBr; + END; + FOR j:=0 TO 3 DO BEGIN + Result[((y+2)*imgx+x+j)*3+0]:=Color[Pixel[12-j]].RGBb; + Result[((y+2)*imgx+x+j)*3+1]:=Color[Pixel[12-j]].RGBg; + Result[((y+2)*imgx+x+j)*3+2]:=Color[Pixel[12-j]].RGBr; + END; + FOR j:=0 TO 3 DO BEGIN + Result[((y+1)*imgx+x+j)*3+0]:=Color[Pixel[8-j]].RGBb; + Result[((y+1)*imgx+x+j)*3+1]:=Color[Pixel[8-j]].RGBg; + Result[((y+1)*imgx+x+j)*3+2]:=Color[Pixel[8-j]].RGBr; + END; + FOR j:=0 TO 3 DO BEGIN + Result[((y+0)*imgx+x+j)*3+0]:=Color[Pixel[4-j]].RGBb; + Result[((y+0)*imgx+x+j)*3+1]:=Color[Pixel[4-j]].RGBg; + Result[((y+0)*imgx+x+j)*3+2]:=Color[Pixel[4-j]].RGBr; + END; + x:=x+4; + IF x=imgx THEN BEGIN + y:=y+4; + x:=0; + END; + END; + END; + + +FUNCTION ImgdataToBmp(imgx,imgy,imgdepth,storetype:LongWord; imgdata:Tdata):Tdata; + CONST BMPheader:Array[0..53] OF Byte= + ($42,$4D,0,0,0,0,0,0,0,0,54,0,0,0, + 40,0,0,0,0,0,0,0,0,0,0,0,1,0,$18,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0); + VAR + i,x,y:LongWord; + BEGIN + CASE storetype OF + 0: BEGIN + SetLength(Result,imgx*imgy*3); + FOR y:=0 TO imgy-1 DO BEGIN + FOR x:=0 TO imgx-1 DO BEGIN + Result[((imgx*y+x)*3)+0]:=Floor( ( (imgdata[(imgx*y+x)*2]+imgdata[(imgx*y+x)*2+1]*256) AND $000F ) / $000F * 255); + Result[((imgx*y+x)*3)+1]:=Floor( ( (imgdata[(imgx*y+x)*2]+imgdata[(imgx*y+x)*2+1]*256) AND $00F0 ) / $00F0 * 255); + Result[((imgx*y+x)*3)+2]:=Floor( ( (imgdata[(imgx*y+x)*2]+imgdata[(imgx*y+x)*2+1]*256) AND $0F00 ) / $0F00 * 255); + END; + END; + END; + 1,2: BEGIN + SetLength(Result,imgx*imgy*3); + FOR y:=0 TO imgy-1 DO BEGIN + FOR x:=0 TO imgx-1 DO BEGIN + Result[((imgx*y+x)*3)+0]:=Floor( ( (imgdata[(imgx*y+x)*2]+imgdata[(imgx*y+x)*2+1]*256) AND $001F ) / $001F * 255); + Result[((imgx*y+x)*3)+1]:=Floor( ( (imgdata[(imgx*y+x)*2]+imgdata[(imgx*y+x)*2+1]*256) AND $03E0 ) / $03E0 * 255); + Result[((imgx*y+x)*3)+2]:=Floor( ( (imgdata[(imgx*y+x)*2]+imgdata[(imgx*y+x)*2+1]*256) AND $7C00 ) / $7C00 * 255); + END; + END; + END; + 8: BEGIN + SetLength(Result,imgx*imgy*3); + FOR y:=0 TO imgy-1 DO BEGIN + FOR x:=0 TO imgx-1 DO BEGIN + Result[((imgx*y+x)*3)+0]:=imgdata[(imgx*y+x)*4+0]; + Result[((imgx*y+x)*3)+1]:=imgdata[(imgx*y+x)*4+1]; + Result[((imgx*y+x)*3)+2]:=imgdata[(imgx*y+x)*4+2]; + END; + END; + END; + 9: BEGIN + Result:=DecompressImage(imgx,imgy,imgdata); + END; + END; + Result:=RevertImage(imgx,imgy,24,Result); + SetLength(Result,imgx*imgy*3+54); + FOR i:=High(Result)-54 DOWNTO 0 DO Result[i+54]:=Result[i]; + + FOR i:=0 TO High(BMPheader) DO Result[i]:=BMPheader[i]; + Result[2]:=((imgx*imgy*3+54) AND $000000FF); + Result[3]:=((imgx*imgy*3+54) AND $0000FF00) DIV $100; + Result[4]:=((imgx*imgy*3+54) AND $00FF0000) DIV $10000; + Result[5]:=((imgx*imgy*3+54) AND $FF000000) DIV $1000000; + Result[18]:=(imgx AND $000000FF) DIV $1; + Result[19]:=(imgx AND $0000FF00) DIV $100; + Result[20]:=(imgx AND $00FF0000) DIV $10000; + Result[21]:=(imgx AND $FF000000) DIV $1000000; + Result[22]:=(imgy AND $000000FF) DIV $1; + Result[23]:=(imgy AND $0000FF00) DIV $100; + Result[24]:=(imgy AND $00FF0000) DIV $10000; + Result[25]:=(imgy AND $FF000000) DIV $1000000; + Result[34]:=((imgx*imgy*3) AND $000000FF) DIV $1; + Result[35]:=((imgx*imgy*3) AND $0000FF00) DIV $100; + Result[36]:=((imgx*imgy*3) AND $00FF0000) DIV $10000; + Result[37]:=((imgx*imgy*3) AND $FF000000) DIV $1000000; + END; + +FUNCTION BmpToImgdata(bmpdata:Tdata; _32bit:Boolean):TImgPackage; + VAR + x,y:LongWord; + r24,g24,b24:Word; + r16,g16,b16:Word; + gesamt:Word; + BEGIN + Result.imgdepth:=0; + IF NOT((bmpdata[00]=$42) AND (bmpdata[01]=$4D)) THEN BEGIN + ShowMessage('Not a standard 24bit bitmap'); + Exit; + END; + IF NOT(bmpdata[10]=54) THEN BEGIN + ShowMessage('Imagedata has to start at 0x54'); + Exit; + END; + IF NOT(bmpdata[14]=40) THEN BEGIN + ShowMessage('Second bitmap header has to have 40 bytes'); + Exit; + END; + IF NOT(bmpdata[28]=24) THEN BEGIN + ShowMessage('Bitmap has to have 24bits'); + Exit; + END; + IF NOT(bmpdata[30]=0) THEN BEGIN + ShowMessage('Bitmap has to be uncompressed'); + Exit; + END; + Result.imgx:=bmpdata[18]+bmpdata[19]*256+bmpdata[20]*256*256+bmpdata[21]*256*256*256; + Result.imgy:=bmpdata[22]+bmpdata[23]*256+bmpdata[24]*256*256+bmpdata[25]*256*256*256; + IF _32bit THEN BEGIN + Result.imgdepth:=32; + Result.storetype:=8; + END ELSE BEGIN + Result.imgdepth:=16; + Result.storetype:=1; + END; + + SetLength(Result.imgdata,Result.imgx*Result.imgy*Result.imgdepth DIV 8); + IF _32bit THEN BEGIN + FOR y:=0 TO Result.imgy-1 DO BEGIN + FOR x:=0 TO Result.imgx-1 DO BEGIN + Result.imgdata[((Result.imgx*y+x)*4)+0]:=bmpdata[54+(Result.imgx*y+x)*3+0]; + Result.imgdata[((Result.imgx*y+x)*4)+1]:=bmpdata[54+(Result.imgx*y+x)*3+1]; + Result.imgdata[((Result.imgx*y+x)*4)+2]:=bmpdata[54+(Result.imgx*y+x)*3+2]; + Result.imgdata[((Result.imgx*y+x)*4)+3]:=0; + END; + END; + END ELSE BEGIN + FOR y:=0 TO Result.imgy-1 DO BEGIN + FOR x:=0 TO Result.imgx-1 DO BEGIN + r24:=bmpdata[54+(Result.imgx*y+x)*3+0]; + g24:=bmpdata[54+(Result.imgx*y+x)*3+1]; + b24:=bmpdata[54+(Result.imgx*y+x)*3+2]; + r16:=(Ceil(r24*$001F/255)) AND $001F; + g16:=(Ceil(g24*$03E0/255)) AND $03E0; + b16:=(Ceil(b24*$7C00/255)) AND $7C00; + gesamt:=r16+g16+b16; + Result.imgdata[((Result.imgx*y+x)*2)+0]:=gesamt AND $00FF; + Result.imgdata[((Result.imgx*y+x)*2)+1]:=(gesamt AND $FF00) DIV 256; + END; + END; + END; + + Result.imgdata:=RevertImage(Result.imgx,Result.imgy,Result.imgdepth,Result.imgdata); + END; + +FUNCTION LoadTXMBconnected(fileid:LongWord):TImgPackage; + VAR + i,x,y,x2,y2,pixelid,imgid:LongWord; + rows,cols:Word; + linkcount:LongWord; + link:LongWord; + single_image:TImgPackage; + images_decoded:Array OF TImgPackage; + x_start,y_start:LongWord; + BEGIN + LoadDatFilePart(fileid,$10,SizeOf(Result.imgx),@Result.imgx); + LoadDatFilePart(fileid,$12,SizeOf(Result.imgy),@Result.imgy); + LoadDatFilePart(fileid,$18,SizeOf(cols),@cols); + LoadDatFilePart(fileid,$1A,SizeOf(rows),@rows); + LoadDatFilePart(fileid,$1C,SizeOf(linkcount),@linkcount); + SetLength(images_decoded,linkcount); + FOR i:=0 TO linkcount-1 DO BEGIN + LoadDatFilePart(fileid,$20+i*4,SizeOf(link),@link); + link:=link DIV 256; + single_image:=LoadImgData(link); + images_decoded[i]:=BmpToImgdata(ImgdataToBmp(single_image.imgx,single_image.imgy,single_image.imgdepth,single_image.storetype,single_image.imgdata),False); + END; + SetLength(Result.imgdata,Result.imgx*Result.imgy*2); + FOR y:=0 TO rows-1 DO BEGIN + FOR x:=0 TO cols-1 DO BEGIN + imgid:=y*cols+x; + x_start:=0; + y_start:=0; + FOR i:=0 TO x DO IF i=400 THEN BEGIN + END ELSE Form7.Width:=400; + IF Form7.Height>=350 THEN BEGIN + END ELSE Form7.Height:=350; + END; + +PROCEDURE TForm7.list_txmpClick(Sender: TObject); + VAR + id:LongWord; + data:Tdata; + img:TImgPackage; + mem:TMemoryStream; + fadingbyte,depthbyte,storebyte:Byte; + BEGIN + id:=StrToInt(MidStr(list_txmp.Items.Strings[list_txmp.ItemIndex],1,5)); + + LoadDatFilePart(id,$88,SizeOf(fadingbyte),@fadingbyte); + LoadDatFilePart(id,$89,SizeOf(depthbyte),@depthbyte); + LoadDatFilePart(id,$90,SizeOf(storebyte),@storebyte); + Form7.check_fading.Checked:=(fadingbyte AND $01)>0; + Form7.check_transparency.Checked:=(depthbyte AND $04)>0; + Form7.check_32bit.Checked:=(storebyte=8); + + img:=LoadImgData(id); + data:=ImgdataToBmp(img.imgx,img.imgy,img.imgdepth,img.storetype,img.imgdata); + + mem:=TMemoryStream.Create; + mem.Write(data[0],Length(data)); + mem.Seek(0,soFromBeginning); + Form7.image_txmppreview.Picture.Bitmap.LoadFromStream(mem); + mem.Free; + + Form7.group_bmpselect.Enabled:=True; + END; + +PROCEDURE TForm7.btn_loadClick(Sender: TObject); + VAR + bmpfile:TFileStream; + mem:TMemoryStream; + BEGIN + IF opend.Execute THEN BEGIN + bmpfile:=TFileStream.Create(opend.FileName, fmOpenRead); + SetLength(actual_bmpdata,bmpfile.Size); + bmpfile.Read(actual_bmpdata[0],bmpfile.Size); + bmpfile.Free; + + mem:=TMemoryStream.Create; + mem.Write(actual_bmpdata[0],Length(actual_bmpdata)); + mem.Seek(0,soFromBeginning); + Form7.image_bmppreview.Picture.Bitmap.LoadFromStream(mem); + mem.Free; + + Form7.group_options.Enabled:=True; + END; + END; + +PROCEDURE TForm7.btn_replaceClick(Sender: TObject); + VAR + id:LongWord; + imgpkg:TImgPackage; + rawfile:TFileStream; + datfile:TFileStream; + dataddr:LongWord; + old_rawaddr,new_rawaddr:LongWord; + oldwidth,oldheight:Word; + oldstore,olddepth,oldfading:Byte; + oldsize:LongWord; + newsize:LongWord; + datword,datbyte:Word; + BEGIN + IF Form7.list_txmp.ItemIndex>=0 THEN BEGIN + imgpkg:=BmpToImgdata(actual_bmpdata,check_32bit.Checked); + datfile:=TFileStream.Create(dat_filename,fmOpenReadWrite); + + id:=StrToInt(MidStr(list_txmp.Items.Strings[list_txmp.ItemIndex],1,5)); + dataddr:=dat_files[id].dataddr; + datfile.Seek(dataddr+$8C,soFromBeginning); + datfile.Read(oldwidth,2); + datfile.Seek(dataddr+$8E,soFromBeginning); + datfile.Read(oldheight,2); + datfile.Seek(dataddr+$88,soFromBeginning); + datfile.Read(oldfading,1); + datfile.Seek(dataddr+$89,soFromBeginning); + datfile.Read(olddepth,1); + datfile.Seek(dataddr+$90,soFromBeginning); + datfile.Read(oldstore,1); + datfile.Seek(dataddr+$9C,soFromBeginning); + datfile.Read(old_rawaddr,4); + IF (oldwidth<>imgpkg.imgx) OR (oldheight<>imgpkg.imgy) THEN BEGIN + IF MessageBox(Form7.Handle, + PChar('Current image and new image have different size'+CrLf+ + '(Current: '+IntToStr(oldwidth)+'x'+IntToStr(oldheight)+ + ' - New: '+IntToStr(imgpkg.imgx)+'x'+IntToStr(imgpkg.imgy)+')'+CrLf+ + 'Replace anyways?'), + PChar(list_txmp.Items.Strings[list_txmp.ItemIndex]), + MB_YESNO)=IDNO THEN Exit; + END; + + rawfile:=TFileStream.Create(raw_filename,fmOpenReadWrite); + + CASE oldstore OF + 9: oldsize:=GetImageDataSize(oldwidth,oldheight,8,(oldfading AND $01)>0); + 0,1,2: oldsize:=GetImageDataSize(oldwidth,oldheight,16,(oldfading AND $01)>0); + 8: oldsize:=GetImageDataSize(oldwidth,oldheight,32,(oldfading AND $01)>0); + ELSE + oldsize:=0; + END; + IF check_32bit.Checked THEN + newsize:=GetImageDataSize(imgpkg.imgx,imgpkg.imgy,32,Form7.check_fading.Checked) + ELSE + newsize:=GetImageDataSize(imgpkg.imgx,imgpkg.imgy,16,Form7.check_fading.Checked); + + IF newsize<=oldsize THEN + new_rawaddr:=old_rawaddr + ELSE + new_rawaddr:=rawfile.Size; + + datbyte:=$00; + IF Form7.check_fading.Checked THEN datbyte:=datbyte OR $01; + datfile.Seek(dataddr+$88,soFromBeginning); + datfile.Write(datbyte,2); + datbyte:=$10; + IF Form7.check_transparency.Checked THEN datbyte:=datbyte OR $04; + datfile.Seek(dataddr+$89,soFromBeginning); + datfile.Write(datbyte,2); + datfile.Seek(dataddr+$8C,soFromBeginning); + datfile.Write(imgpkg.imgx,2); + datfile.Seek(dataddr+$8E,soFromBeginning); + datfile.Write(imgpkg.imgy,2); + IF check_32bit.Checked THEN + datbyte:=$08 + ELSE + datbyte:=$01; + datfile.Seek(dataddr+$90,soFromBeginning); + datfile.Write(datbyte,2); + datfile.Seek(dataddr+$9C,soFromBeginning); + datfile.Write(new_rawaddr,4); + datfile.Free; + + IF Form7.check_fading.Checked THEN BEGIN + imgpkg.imgdata:=CreateFadedImage(imgpkg); + END; + + rawfile.Seek(new_rawaddr,soFromBeginning); + rawfile.Write(imgpkg.imgdata[0],Length(imgpkg.imgdata)); + rawfile.Free; + + ShowMessage('TXMP-image replaced'); + END; + END; + +END. Index: /oup/releases/0.15a/OniUnPacker.bdsproj =================================================================== --- /oup/releases/0.15a/OniUnPacker.bdsproj (revision 21) +++ /oup/releases/0.15a/OniUnPacker.bdsproj (revision 21) @@ -0,0 +1,171 @@ + + + + + + + + + + + + OniUnPacker.dpr + + + 7.0 + + + 8 + 0 + 1 + 1 + 0 + 0 + 1 + 1 + 1 + 0 + 0 + 1 + 0 + 1 + 1 + 1 + 0 + 0 + 0 + 0 + 0 + 1 + 0 + 1 + 1 + 1 + True + True + WinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE; + + False + + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + False + False + False + True + True + True + + + 0 + 0 + 1 + False + False + False + 16384 + 1048576 + 4194304 + + + + + + + + + xmlrtl;rtl;vcl;vclie;inet;inetdbbde;inetdbxpress;vclx;IndySystem;IndyCore;dbrtl;dsnap;soaprtl;IndyProtocols;bdertl;vcldbx;vcldb;webdsnap;websnap;vclactnband;GridPackd2005;TWrapGrid;Package1;A406_R70;CoolTrayIcon_D6plus + + + False + + + + + + False + + + + + + False + + + False + False + 1 + 0 + 0 + 0 + False + False + False + False + False + 1031 + 1252 + + + + + 1.0.0.0 + + + + + + 1.0.0.0 + + + (untitled) + Borland Web Wizard Package + + + Index: /oup/releases/0.15a/OniUnPacker.cfg =================================================================== --- /oup/releases/0.15a/OniUnPacker.cfg (revision 21) +++ /oup/releases/0.15a/OniUnPacker.cfg (revision 21) @@ -0,0 +1,38 @@ +-$A8 +-$B- +-$C+ +-$D+ +-$E- +-$F- +-$G+ +-$H+ +-$I+ +-$J- +-$K- +-$L+ +-$M- +-$N+ +-$O+ +-$P+ +-$Q- +-$R- +-$S- +-$T- +-$U- +-$V+ +-$W- +-$X+ +-$YD +-$Z1 +-cg +-AWinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE; +-H+ +-W+ +-M +-$M16384,1048576 +-K$00400000 +-LE"C:\Dokumente und Einstellungen\Administrator\Eigene Dateien\Borland Studio Projects\Bpl" +-LN"C:\Dokumente und Einstellungen\Administrator\Eigene Dateien\Borland Studio Projects\Bpl" +-w-UNSAFE_TYPE +-w-UNSAFE_CODE +-w-UNSAFE_CAST Index: /oup/releases/0.15a/OniUnPacker.dpr =================================================================== --- /oup/releases/0.15a/OniUnPacker.dpr (revision 21) +++ /oup/releases/0.15a/OniUnPacker.dpr (revision 21) @@ -0,0 +1,23 @@ +PROGRAM OniUnPacker; +uses + Forms, + Unit1_main in 'Unit1_main.pas' {Form1}, + Unit2_functions in 'Unit2_functions.pas', + Unit3_data in 'Unit3_data.pas', + Unit4_Exporters in 'Unit4_Exporters.pas', + Unit5_preview in 'Unit5_preview.pas' {Form5}, + Unit6_imgfuncs in 'Unit6_imgfuncs.pas', + Unit7_txmpreplace in 'Unit7_txmpreplace.pas' {Form7}, + Unit8_binedit in 'Unit8_binedit.pas' {Form8}; + +{$R *.res} + +BEGIN + Application.Initialize; + Application.Title:='Oni Un/Packer'; + Application.CreateForm(TForm1, Form1); + Application.CreateForm(TForm5, Form5); + Application.CreateForm(TForm7, Form7); + Application.CreateForm(TForm8, Form8); + Application.Run; +END. Index: /oup/releases/0.15a/SQLite3.pas =================================================================== --- /oup/releases/0.15a/SQLite3.pas (revision 21) +++ /oup/releases/0.15a/SQLite3.pas (revision 21) @@ -0,0 +1,120 @@ +unit SQLite3; + +{ + Simplified interface for SQLite. + Updated for Sqlite 3 by Tim Anderson (tim@itwriting.com) + Note: NOT COMPLETE for version 3, just minimal functionality + Adapted from file created by Pablo Pissanetzky (pablo@myhtpc.net) + which was based on SQLite.pas by Ben Hochstrasser (bhoc@surfeu.ch) +} + +interface + +const +// Return values for sqlite3_exec() and sqlite3_step() + +SQLITE_OK = 0; // Successful result +SQLITE_ERROR = 1; // SQL error or missing database +SQLITE_INTERNAL = 2; // An internal logic error in SQLite +SQLITE_PERM = 3 ; // Access permission denied +SQLITE_ABORT = 4; // Callback routine requested an abort +SQLITE_BUSY = 5; // The database file is locked +SQLITE_LOCKED = 6; // A table in the database is locked +SQLITE_NOMEM = 7; // A malloc() failed +SQLITE_READONLY = 8; // Attempt to write a readonly database +SQLITE_INTERRUPT = 9; // Operation terminated by sqlite3_interrupt() +SQLITE_IOERR = 10; // Some kind of disk I/O error occurred +SQLITE_CORRUPT = 11; // The database disk image is malformed +SQLITE_NOTFOUND = 12; // (Internal Only) Table or record not found +SQLITE_FULL = 13; // Insertion failed because database is full +SQLITE_CANTOPEN = 14; // Unable to open the database file +SQLITE_PROTOCOL = 15; // Database lock protocol error +SQLITE_EMPTY = 16; // Database is empty +SQLITE_SCHEMA = 17; // The database schema changed +SQLITE_TOOBIG = 18; // Too much data for one row of a table +SQLITE_CONSTRAINT = 19; // Abort due to contraint violation +SQLITE_MISMATCH = 20; // Data type mismatch +SQLITE_MISUSE = 21; // Library used incorrectly +SQLITE_NOLFS = 22; // Uses OS features not supported on host +SQLITE_AUTH = 23; // Authorization denied +SQLITE_FORMAT = 24; // Auxiliary database format error +SQLITE_RANGE = 25; // 2nd parameter to sqlite3_bind out of range +SQLITE_NOTADB = 26; // File opened that is not a database file +SQLITE_ROW = 100; // sqlite3_step() has another row ready +SQLITE_DONE = 101; // sqlite3_step() has finished executing + +SQLITE_INTEGER = 1; +SQLITE_FLOAT = 2; +SQLITE_TEXT = 3; +SQLITE_BLOB = 4; +SQLITE_NULL = 5; + +type +TSQLiteDB = Pointer; +TSQLiteResult = ^PChar; +TSQLiteStmt = Pointer; + +function SQLite3_Open (dbname: PChar; var db: TSqliteDB): integer; cdecl; external 'sqlite3.dll' name 'sqlite3_open'; +function SQLite3_Close (db: TSQLiteDB): integer; cdecl; external 'sqlite3.dll' name 'sqlite3_close'; +function SQLite3_Exec (db: TSQLiteDB; SQLStatement: PChar; CallbackPtr: Pointer; Sender: TObject; var ErrMsg: PChar): integer; cdecl; external 'sqlite3.dll' name 'sqlite3_exec'; +function SQLite3_Version (): PChar; cdecl; external 'sqlite3.dll' name 'sqlite3_libversion'; +function SQLite3_ErrMsg (db: TSQLiteDB): PChar; cdecl; external 'sqlite3.dll' name 'sqlite3_errmsg'; +function SQLite3_ErrCode (db: TSQLiteDB): integer; cdecl; external 'sqlite3.dll' name 'sqlite3_errcode'; +procedure SQlite3_Free (P: PChar); cdecl; external 'sqlite3.dll' name 'sqlite3_free'; +function SQLite3_GetTable (db: TSQLiteDB; SQLStatement: PChar; var ResultPtr: TSQLiteResult; var RowCount: Cardinal; var ColCount: Cardinal; var ErrMsg: PChar): integer; cdecl; external 'sqlite3.dll' name 'sqlite3_get_table'; +procedure SQLite3_FreeTable (Table:TSQLiteResult ); cdecl; external 'sqlite3.dll' name 'sqlite3_free_table'; +function SQLite3_Complete (P: PChar): boolean; cdecl; external 'sqlite3.dll' name 'sqlite3_complete'; +function SQLite3_LastInsertRowID(db: TSQLiteDB): int64; cdecl; external 'sqlite3.dll' name 'sqlite3_last_insert_rowid'; +procedure SQLite3_Interrupt (db: TSQLiteDB); cdecl; external 'sqlite3.dll' name 'sqlite3_interrupt'; +procedure SQLite3_BusyHandler (db: TSQLiteDB; CallbackPtr: Pointer; Sender: TObject); cdecl; external 'sqlite3.dll' name'sqlite3_busy_handler' ; +procedure SQLite3_BusyTimeout (db: TSQLiteDB; TimeOut: integer); cdecl; external 'sqlite3.dll' name 'sqlite3_busy_timeout'; +function SQLite3_Changes (db: TSQLiteDB): integer; cdecl; external 'sqlite3.dll' name 'sqlite3_changes'; +function SQLite3_TotalChanges (db: TSQLiteDB): integer; cdecl; external 'sqlite3.dll' name 'sqlite3_total_changes'; +function SQLite3_Prepare (db: TSQLiteDB; SQLStatement: PChar; nBytes: integer; var hStmt: TSqliteStmt; var pzTail: PChar): integer; cdecl; external 'sqlite3.dll' name 'sqlite3_prepare'; +function SQLite3_ColumnCount (hStmt: TSqliteStmt): integer; cdecl; external 'sqlite3.dll' name 'sqlite3_column_count'; +function Sqlite3_ColumnName (hStmt: TSqliteStmt; ColNum: integer): pchar; cdecl; external 'sqlite3.dll' name 'sqlite3_column_name'; +function Sqlite3_ColumnDeclType (hStmt: TSqliteStmt; ColNum: integer): pchar; cdecl; external 'sqlite3.dll' name 'sqlite3_column_decltype'; +function Sqlite3_Step (hStmt: TSqliteStmt): integer; cdecl; external 'sqlite3.dll' name 'sqlite3_step'; +function SQLite3_DataCount (hStmt: TSqliteStmt): integer; cdecl; external 'sqlite3.dll' name 'sqlite3_data_count'; + +function Sqlite3_ColumnBlob (hStmt: TSqliteStmt; ColNum: integer):pointer; cdecl; external 'sqlite3.dll' name 'sqlite3_column_blob'; +function Sqlite3_ColumnBytes (hStmt: TSqliteStmt; ColNum: integer): integer; cdecl; external 'sqlite3.dll' name 'sqlite3_column_bytes'; +function Sqlite3_ColumnDouble (hStmt: TSqliteStmt; ColNum: integer): double; cdecl; external 'sqlite3.dll' name 'sqlite3_column_double'; +function Sqlite3_ColumnInt (hStmt: TSqliteStmt; ColNum: integer): integer; cdecl; external 'sqlite3.dll' name 'sqlite3_column_int'; +function Sqlite3_ColumnText (hStmt: TSqliteStmt; ColNum: integer): pchar; cdecl; external 'sqlite3.dll' name 'sqlite3_column_text'; +function Sqlite3_ColumnType (hStmt: TSqliteStmt; ColNum: integer): integer; cdecl; external 'sqlite3.dll' name 'sqlite3_column_type'; + // function Sqlite3_ColumnInt64 (hStmt: TSqliteStmt; ColNum: integer): SqliteInt64; cdecl; external 'sqlite3.dll' name 'sqlite3_column_int64'; +function SQLite3_Finalize (hStmt: TSqliteStmt): integer; cdecl; external 'sqlite3.dll' name 'sqlite3_finalize'; +function SQLite3_Reset (hStmt: TSqliteStmt): integer; cdecl; external 'sqlite3.dll' name 'sqlite3_reset'; + +// +// In the SQL strings input to sqlite3_prepare() and sqlite3_prepare16(), +// one or more literals can be replace by a wildcard "?" or ":N:" where +// N is an integer. These value of these wildcard literals can be set +// using the routines listed below. +// +// In every case, the first parameter is a pointer to the sqlite3_stmt +// structure returned from sqlite3_prepare(). The second parameter is the +// index of the wildcard. The first "?" has an index of 1. ":N:" wildcards +// use the index N. +// + // The fifth parameter to sqlite3_bind_blob(), sqlite3_bind_text(), and + //sqlite3_bind_text16() is a destructor used to dispose of the BLOB or +//text after SQLite has finished with it. If the fifth argument is the +// special value SQLITE_STATIC, then the library assumes that the information +// is in static, unmanaged space and does not need to be freed. If the +// fifth argument has the value SQLITE_TRANSIENT, then SQLite makes its +// own private copy of the data. +// +// The sqlite3_bind_* routine must be called before sqlite3_step() after +// an sqlite3_prepare() or sqlite3_reset(). Unbound wildcards are interpreted +// as NULL. +// + +function SQLite3_BindBlob(hStmt: TSqliteStmt; ParamNum: integer; +ptrData: pointer; numBytes: integer; ptrDestructor: pointer): integer; +cdecl; external 'sqlite3.dll' name 'sqlite3_bind_blob'; + +implementation + +end. Index: /oup/releases/0.15a/SQLiteTable3.pas =================================================================== --- /oup/releases/0.15a/SQLiteTable3.pas (revision 21) +++ /oup/releases/0.15a/SQLiteTable3.pas (revision 21) @@ -0,0 +1,883 @@ +unit SQLiteTable3; + +{ + Simple classes for using SQLite's exec and get_table. + + TSQLiteDatabase wraps the calls to open and close an SQLite database. + It also wraps SQLite_exec for queries that do not return a result set + + TSQLiteTable wraps sqlite_get_table. + It allows accessing fields by name as well as index and can step through a + result set with the Next procedure. + + Adapted by Tim Anderson (tim@itwriting.com) + Originally created by Pablo Pissanetzky (pablo@myhtpc.net) +} + +interface + +uses + Windows, SQLite3, Classes, Sysutils; + +const + dtStr = 0; + dtInt = 1; + dtBool = 2; + dtNumeric = 3; + dtBlob = 4; + +type + + ESQLiteException = class(Exception) + private + public + end; + + TSQLiteTable = class; + + TSQLiteDatabase = class + private + fDB: TSQLiteDB; + fInTrans: Boolean; + procedure RaiseError(s: string; SQL: string); + + public + constructor Create(const FileName: string); + destructor Destroy; override; + function GetTable(const SQL: string): TSQLiteTable; + procedure ExecSQL(const SQL: string); + procedure UpdateBlob(const SQL: string; BlobData: TStream); + procedure BeginTransaction; + procedure Commit; + procedure Rollback; + function TableExists(TableName: string): boolean; + function GetLastInsertRowID: int64; + + published + property isTransactionOpen: boolean read fInTrans; + + end; + + TSQLiteTable = class + private + fResults: TList; + fRowCount: Cardinal; + fColCount: Cardinal; + fCols: TStringList; + fColTypes: TList; + fRow: Cardinal; + + function GetFields(I: Integer): string; + function GetEOF: Boolean; + function GetBOF: Boolean; + function GetColumns(I: Integer): string; + function GetFieldByName(FieldName: string): string; + function GetFieldIndex(FieldName: string): integer; + function GetCount: Integer; + function GetCountResult: Integer; + + + public + constructor Create(DB: TSQLiteDatabase; const SQL: string); + destructor Destroy; override; + function FieldAsInteger(FieldName: string): integer; + function FieldAsBool(FieldName: string): boolean; + function FieldAsBlob(FieldName: string): TMemoryStream; + function FieldAsBlobText(FieldName: string): string; + function FieldIsNull(FieldName: string): boolean; + function FieldAsString(FieldName: string): string; + function FieldAsDouble(FieldName: string): double; +{ function FieldAsInteger(I: integer): integer; + function FieldAsBool(I: integer): boolean; + function FieldAsBlob(I: Integer): TMemoryStream; + function FieldAsBlobText(I: Integer): string; + function FieldIsNull(I: integer): boolean; + function FieldAsString(I: Integer): string; + function FieldAsDouble(I: Integer): double; +} function Next: Boolean; + function Previous: Boolean; + property EOF: Boolean read GetEOF; + property BOF: Boolean read GetBOF; + property Fields[I: Integer]: string read GetFields; + property FieldByName[FieldName: string]: string read GetFieldByName; + property FieldIndex[FieldName: string]: integer read GetFieldIndex; + property Columns[I: Integer]: string read GetColumns; + property ColCount: Cardinal read fColCount; + property RowCount: Cardinal read fRowCount; + property Row: Cardinal read fRow; + function MoveFirst: boolean; + function MoveLast: boolean; + + + property Count: Integer read GetCount; + + // The property CountResult is used when you execute count(*) queries. + // It returns 0 if the result set is empty or the value of the + // first field as an integer. + property CountResult: Integer read GetCountResult; + end; + + +procedure DisposePointer(ptr: pointer); cdecl; + +implementation + +uses + strutils; + + +procedure DisposePointer(ptr: pointer); cdecl; +begin + + if assigned(ptr) then + begin freemem(ptr) end; + +end; + +//------------------------------------------------------------------------------ +// TSQLiteDatabase +//------------------------------------------------------------------------------ + +constructor TSQLiteDatabase.Create(const FileName: string); +var + Msg: pchar; + iResult: integer; +begin + inherited Create; + + self.fInTrans := false; + + Msg := nil; + try + iResult := SQLite3_Open(PChar(FileName), Fdb); + + if iResult <> SQLITE_OK then + begin + if Assigned(Fdb) then + begin + Msg := Sqlite3_ErrMsg(Fdb); + raise ESqliteException.CreateFmt('Failed to open database "%s" : %s', [FileName, Msg]); + end + else + begin raise ESqliteException.CreateFmt('Failed to open database "%s" : unknown error', [FileName]) end; + end; + + //set a few configs + self.ExecSQL('PRAGMA SYNCHRONOUS=NORMAL;'); + + //this pragma not recommended and may disappear in future + //sqlite versions + //self.ExecSQL('PRAGMA full_column_names = 1;'); + + finally + if Assigned(Msg) then + begin SQLite3_Free(Msg) end; + end; + + +end; + + +//.............................................................................. + +destructor TSQLiteDatabase.Destroy; +begin + + if self.fInTrans then + begin self.ExecSQL('ROLLBACK;') end; //assume rollback + + if Assigned(fDB) then + begin SQLite3_Close(fDB) end; + + inherited; +end; + +function TSQLiteDatabase.GetLastInsertRowID: int64; +begin + result := Sqlite3_LastInsertRowID(self.fDB); +end; + +//.............................................................................. + +procedure TSQLiteDatabase.RaiseError(s: string; SQL: string); +//look up last error and raise and exception with an appropriate message +var + Msg: PChar; +begin + + Msg := nil; + + if sqlite3_errcode(self.fDB) <> SQLITE_OK then + Msg := sqlite3_errmsg(self.fDB); + + if Msg <> nil then + raise ESqliteException.CreateFmt(s + ' "%s" : %s', [SQL, Msg]) + else + raise ESqliteException.CreateFmt(s, [SQL, 'No message']); + +end; + +procedure TSQLiteDatabase.ExecSQL(const SQL: string); +var + Stmt: TSQLiteStmt; + NextSQLStatement: Pchar; + iStepResult: integer; +begin + try + + if Sqlite3_Prepare(self.fDB, PChar(SQL), -1, Stmt, NextSQLStatement) <> SQLITE_OK then + begin RaiseError('Error executing SQL', SQL) end; + + if (Stmt = nil) then + begin RaiseError('Could not prepare SQL statement', SQL) end; + + iStepResult := Sqlite3_step(Stmt); + + if (iStepResult <> SQLITE_DONE) then + begin RaiseError('Error executing SQL statement', SQL) end; + + finally + + if Assigned(Stmt) then + begin Sqlite3_Finalize(stmt) end; + + end; +end; + +procedure TSQLiteDatabase.UpdateBlob(const SQL: string; BlobData: TStream); +var + iSize: integer; + ptr: pointer; + Stmt: TSQLiteStmt; + Msg: Pchar; + NextSQLStatement: Pchar; + iStepResult: integer; + iBindResult: integer; +begin +//expects SQL of the form 'UPDATE MYTABLE SET MYFIELD = ? WHERE MYKEY = 1' + + if pos('?', SQL) = 0 then + begin RaiseError('SQL must include a ? parameter', SQL) end; + + Msg := nil; + try + + if Sqlite3_Prepare(self.fDB, PChar(SQL), -1, Stmt, NextSQLStatement) <> SQLITE_OK then + begin RaiseError('Could not prepare SQL statement', SQL) end; + + if (Stmt = nil) then + begin RaiseError('Could not prepare SQL statement', SQL) end; + +//now bind the blob data + iSize := BlobData.size; + + GetMem(ptr, iSize); + + if (ptr = nil) then + begin raise ESqliteException.CreateFmt('Error getting memory to save blob', [SQL, 'Error']) end; + + BlobData.position := 0; + BlobData.Read(ptr^, iSize); + + iBindResult := SQLite3_BindBlob(stmt, 1, ptr, iSize, @DisposePointer); + + if iBindResult <> SQLITE_OK then + begin RaiseError('Error binding blob to database', SQL) end; + + iStepResult := Sqlite3_step(Stmt); + + if (iStepResult <> SQLITE_DONE) then + begin RaiseError('Error executing SQL statement', SQL) end; + + finally + + if Assigned(Stmt) then + begin Sqlite3_Finalize(stmt) end; + + if Assigned(Msg) then + begin SQLite3_Free(Msg) end; + end; + +end; + +//.............................................................................. + +function TSQLiteDatabase.GetTable(const SQL: string): TSQLiteTable; +begin + Result := TSQLiteTable.Create(Self, SQL); +end; + +procedure TSQLiteDatabase.BeginTransaction; +begin + if not self.fInTrans then + begin + self.ExecSQL('BEGIN TRANSACTION;'); + self.fInTrans := true; + end + else + begin raise ESqliteException.Create('Transaction already open') end; +end; + +procedure TSQLiteDatabase.Commit; +begin + self.ExecSQL('COMMIT;'); + self.fInTrans := false; +end; + +procedure TSQLiteDatabase.Rollback; +begin + self.ExecSQL('ROLLBACK;'); + self.fInTrans := false; +end; + +function TSQLiteDatabase.TableExists(TableName: string): boolean; +var + sql: string; + ds: TSqliteTable; +begin +//returns true if table exists in the database + sql := 'select [sql] from sqlite_master where [type] = ''table'' and lower(name) = ''' + lowercase(TableName) + ''' '; + + try + + ds := self.GetTable(sql); + + result := (ds.Count > 0); + + finally + + freeandnil(ds); + + end; + +end; + + +//------------------------------------------------------------------------------ +// TSQLiteTable +//------------------------------------------------------------------------------ + +constructor TSQLiteTable.Create(DB: TSQLiteDatabase; const SQL: string); +var + Stmt: TSQLiteStmt; + NextSQLStatement: Pchar; + iStepResult: integer; + + ptr: pointer; + iNumBytes: integer; + thisBlobValue: TMemoryStream; + thisStringValue: pstring; + thisBoolValue: pBoolean; + thisDoubleValue: pDouble; + thisIntValue: pInteger; + thisColType: pInteger; + i: integer; + DeclaredColType: Pchar; + ActualColType: integer; + ptrValue: Pchar; + +begin + + try + + self.fRowCount := 0; + self.fColCount := 0; + +//if there are several SQL statements in SQL, NextSQLStatment points to the +//beginning of the next one. Prepare only prepares the first SQL statement. + + if Sqlite3_Prepare(Db.fDB, PChar(SQL), -1, Stmt, NextSQLStatement) <> SQLITE_OK then + begin Db.RaiseError('Error executing SQL', SQL) end; + + if (Stmt = nil) then + begin Db.RaiseError('Could not prepare SQL statement', SQL) end; + + iStepResult := Sqlite3_step(Stmt); + + while (iStepResult <> SQLITE_DONE) do + begin + + case iStepResult of + SQLITE_ROW: + begin + + inc(fRowCount); + + if (fRowCount = 1) then + begin + //get data types + fCols := TStringList.Create; + fCols.CaseSensitive := False; + fColTypes := TList.Create; + + fColCount := SQLite3_ColumnCount(stmt); + + for i := 0 to Pred(fColCount) do + begin + fCols.Add(Sqlite3_ColumnName(stmt, i)); + end; + + for i := 0 to Pred(fColCount) do + begin + + new(thisColType); + DeclaredColType := Sqlite3_ColumnDeclType(stmt, i); + + if DeclaredColType = nil then begin + //use the actual column type instead + //seems to be needed for last_insert_rowid + thisColType^ := Sqlite3_ColumnType(stmt, i); + end else begin + DeclaredColType := strupper(DeclaredColType); + + if DeclaredColType = 'INTEGER' then + begin thisColType^ := dtInt end + else + if DeclaredColType = 'BOOLEAN' then + begin thisColType^ := dtBool end + else + if (DeclaredColType = 'NUMERIC') or (DeclaredColType = 'FLOAT') or (DeclaredColType = 'DOUBLE') then + begin thisColType^ := dtNumeric end + else + if DeclaredColType = 'BLOB' then + begin thisColType^ := dtBlob end + else + begin thisColType^ := dtStr end; + end; + + fColTypes.Add(thiscoltype); + end; + + fResults := TList.Create; + + end; + + //get column values + for i := 0 to Pred(ColCount) do + begin + + ActualColType := Sqlite3_ColumnType(stmt, i); + if (ActualColType = SQLITE_NULL) then + begin fResults.Add(nil) end + else + begin + if pInteger(fColTypes[i])^ = dtInt then + begin + new(thisintvalue); + thisintvalue^ := Sqlite3_ColumnInt(stmt, i); + fResults.Add(thisintvalue); + end + else + if pInteger(fColTypes[i])^ = dtBool then + begin + new(thisboolvalue); + thisboolvalue^ := not (Sqlite3_ColumnInt(stmt, i) = 0); + fResults.Add(thisboolvalue); + end + else + if pInteger(fColTypes[i])^ = dtNumeric then + begin + new(thisdoublevalue); + thisdoublevalue^ := Sqlite3_ColumnDouble(stmt, i); + fResults.Add(thisdoublevalue); + end + else + if pInteger(fColTypes[i])^ = dtBlob then + begin + iNumBytes := Sqlite3_ColumnBytes(stmt, i); + + if iNumBytes = 0 then + begin thisblobvalue := nil end + else + begin + thisblobvalue := TMemoryStream.Create; + thisblobvalue.position := 0; + ptr := Sqlite3_ColumnBlob(stmt, i); + thisblobvalue.writebuffer(ptr^, iNumBytes); + end; + fResults.Add(thisblobvalue); + + end + else + begin + new(thisstringvalue); + ptrValue := Sqlite3_ColumnText(stmt, i); + setstring(thisstringvalue^, ptrvalue, strlen(ptrvalue)); + fResults.Add(thisstringvalue); + end; + end; + + end; + + + + end; + + SQLITE_BUSY: + begin raise ESqliteException.CreateFmt('Could not prepare SQL statement', [SQL, 'SQLite is Busy']) end; + else + begin Db.RaiseError('Could not retrieve data', SQL) end; + end; + + iStepResult := Sqlite3_step(Stmt); + + end; + + fRow := 0; + + finally + if Assigned(Stmt) then + begin Sqlite3_Finalize(stmt) end; + end; + +end; + +//.............................................................................. + +destructor TSQLiteTable.Destroy; +var i: integer; + iColNo: integer; +begin + + + if Assigned(fResults) then + begin for i := 0 to fResults.Count - 1 do + begin + //check for blob type + iColNo := (i mod fColCount); + case pInteger(self.fColTypes[iColNo])^ of + dtBlob: + begin + TMemoryStream(fResults[i]).free; + end; + dtStr: + begin + if fResults[i] <> nil then + begin + setstring(string(fResults[i]^), nil, 0); + dispose(fResults[i]); + end; + end; + else + begin + dispose(fResults[i]) + end; + end; + end; + fResults.Free; + end; + + if Assigned(fCols) then + begin fCols.Free end; + + if Assigned(fColTypes) then + begin for i := 0 to fColTypes.Count - 1 do + begin + dispose(fColTypes[i]); + end end; + fColTypes.Free; + inherited; + end; + +//.............................................................................. + +function TSQLiteTable.GetColumns(I: Integer): string; +begin + Result := fCols[I]; +end; + +//.............................................................................. + +function TSQLiteTable.GetCountResult: Integer; +begin + if not EOF then + begin Result := StrToInt(Fields[0]) end + else + begin Result := 0 end; +end; + +function TSQLiteTable.GetCount: Integer; +begin + Result := FRowCount; +end; + +//.............................................................................. + +function TSQLiteTable.GetEOF: Boolean; +begin + Result := fRow >= fRowCount; +end; + +function TSQLiteTable.GetBOF: Boolean; +begin + Result := fRow <= 0; +end; + +//.............................................................................. + +function TSQLiteTable.GetFieldByName(FieldName: string): string; +begin + Result := GetFields(self.GetFieldIndex(FieldName)); +end; + +function TSQLiteTable.GetFieldIndex(FieldName: string): integer; +begin + + if (fCols = nil) then + begin + raise ESqliteException.Create('Field ' + fieldname + ' Not found. Empty dataset'); + exit; + end; + + if (fCols.count = 0) then + begin + raise ESqliteException.Create('Field ' + fieldname + ' Not found. Empty dataset'); + exit; + end; + + result := fCols.IndexOf(FieldName); + + if (result < 0) then + begin raise ESqliteException.Create('Field not found in dataset: ' + fieldname) end; + +end; + +//.............................................................................. + +function TSQLiteTable.GetFields(I: Integer): string; +var + thisvalue: pstring; + ptr: pointer; + thisboolvalue: pBoolean; + thistype: integer; +begin + Result := ''; + + if EOF then + begin raise ESqliteException.Create('Table is at End of File') end; + +//integer and boolean types are not stored in the resultset +//as strings, so they should be retrieved using the type-specific +//methods + + thistype := pInteger(self.fColTypes[I])^; + + if (thistype = dtInt) or (thistype = dtNumeric) or (thistype = dtBlob) then + begin + ptr := self.fResults[(self.frow * self.fColCount) + I]; + + if ptr <> nil then + begin + raise ESqliteException.Create('Use the specific methods for integer, numeric or blob fields'); + end; + + end + else + if pInteger(self.fColTypes[I])^ = dtBool then + begin + thisboolvalue := self.fResults[(self.frow * self.fColCount) + I]; + if thisboolvalue <> nil then + begin if thisboolvalue^ then + begin result := '1' end + else + begin result := '0' end end; + end + + else + + begin + + thisvalue := self.fResults[(self.frow * self.fColCount) + I]; + if (thisvalue <> nil) then + begin Result := thisvalue^ end + else + begin Result := '' end; //return empty string + end; + +end; + +function TSqliteTable.FieldAsBlob(FieldName: string): TMemoryStream; +var + i: Integer; +begin + + if EOF then + begin raise ESqliteException.Create('Table is at End of File') end; + + i:=Self.FieldIndex[FieldName]; + + if (self.fResults[(self.frow * self.fColCount) + I] = nil) then + begin result := nil end + else + if pInteger(self.fColTypes[I])^ = dtBlob then + begin result := TMemoryStream(self.fResults[(self.frow * self.fColCount) + I]) end + else + begin raise ESqliteException.Create('Not a Blob field') end; +end; + +function TSqliteTable.FieldAsBlobText(FieldName: string): string; +var + MemStream: TMemoryStream; + Buffer: PChar; +begin + result := ''; + + MemStream := self.FieldAsBlob(FieldName); + + if MemStream <> nil then + begin if MemStream.Size > 0 then + begin + MemStream.position := 0; + + Buffer := stralloc(MemStream.Size + 1); + MemStream.readbuffer(Buffer[0], MemStream.Size); + (Buffer + MemStream.Size)^ := chr(0); + SetString(Result, Buffer, MemStream.size); + strdispose(Buffer); + end end; + +end; + + +function TSqliteTable.FieldAsInteger(FieldName: string): integer; +var + i: Integer; +begin + + if EOF then + begin raise ESqliteException.Create('Table is at End of File') end; + + i:=Self.FieldIndex[FieldName]; + + if (self.fResults[(self.frow * self.fColCount) + I] = nil) then + begin result := 0 end + else + if pInteger(self.fColTypes[I])^ = dtInt then + begin result := pInteger(self.fResults[(self.frow * self.fColCount) + I])^ end + else + if pInteger(self.fColTypes[I])^ = dtNumeric then + begin result := trunc(strtofloat(pString(self.fResults[(self.frow * self.fColCount) + I])^)) end + else + begin raise ESqliteException.Create('Not an integer or numeric field') end; + +end; + +function TSqliteTable.FieldAsDouble(FieldName: string): double; +var + i: Integer; +begin + + if EOF then + begin raise ESqliteException.Create('Table is at End of File') end; + + i:=Self.FieldIndex[FieldName]; + + if (self.fResults[(self.frow * self.fColCount) + I] = nil) then + begin result := 0 end + else + if pInteger(self.fColTypes[I])^ = dtInt then + begin result := pInteger(self.fResults[(self.frow * self.fColCount) + I])^ end + else + if pInteger(self.fColTypes[I])^ = dtNumeric then + begin result := pDouble(self.fResults[(self.frow * self.fColCount) + I])^ end + else + begin raise ESqliteException.Create('Not an integer or numeric field') end; + +end; + +function TSqliteTable.FieldAsBool(FieldName: string): boolean; +var + i: Integer; +begin + + if EOF then + begin raise ESqliteException.Create('Table is at End of File') end; + + i:=Self.FieldIndex[FieldName]; + + if (self.fResults[(self.frow * self.fColCount) + I] = nil) then + begin result := false end + else + if pInteger(self.fColTypes[I])^ = dtBool then + begin result := pBoolean(self.fResults[(self.frow * self.fColCount) + I])^ end + else + begin raise ESqliteException.Create('Not a boolean field') end; +end; + +function TSqliteTable.FieldAsString(FieldName: string): string; +var + i: Integer; +begin + + if EOF then + begin raise ESqliteException.Create('Table is at End of File') end; + + i:=Self.FieldIndex[FieldName]; + + if (self.fResults[(self.frow * self.fColCount) + I] = nil) then + begin result := '' end + else + begin result := self.GetFields(I) end; + +end; + +function TSqliteTable.FieldIsNull(FieldName: string): boolean; +var + thisvalue: pointer; + i: Integer; +begin + + if EOF then + begin raise ESqliteException.Create('Table is at End of File') end; + + i:=Self.FieldIndex[FieldName]; + + thisvalue := self.fResults[(self.frow * self.fColCount) + I]; + result := (thisvalue = nil); +end; + +//.............................................................................. + +function TSQLiteTable.Next: boolean; +begin + result := false; + if not EOF then + begin + Inc(fRow); + result := true; + end; +end; + +function TSQLiteTable.Previous: boolean; +begin + result := false; + if not BOF then + begin + Dec(fRow); + result := true; + end; +end; + +function TSQLiteTable.MoveFirst: boolean; +begin + result := false; + if self.fRowCount > 0 then + begin + fRow := 0; + result := true; + end; +end; + +function TSQLiteTable.MoveLast: boolean; +begin + result := false; + if self.fRowCount > 0 then + begin + fRow := fRowCount - 1; + result := true; + end; +end; + + +end. + Index: /oup/releases/0.15a/Unit1_main.dfm =================================================================== --- /oup/releases/0.15a/Unit1_main.dfm (revision 21) +++ /oup/releases/0.15a/Unit1_main.dfm (revision 21) @@ -0,0 +1,261 @@ +object Form1: TForm1 + Left = 0 + Top = 0 + HorzScrollBar.Visible = False + VertScrollBar.Visible = False + AutoScroll = False + Caption = 'Form1' + ClientHeight = 582 + ClientWidth = 692 + Color = clBtnFace + Font.Charset = DEFAULT_CHARSET + Font.Color = clWindowText + Font.Height = -11 + Font.Name = 'Tahoma' + Font.Style = [] + Menu = menu + OldCreateOrder = False + OnClose = FormClose + OnCreate = FormCreate + OnResize = FormResize + PixelsPerInch = 96 + TextHeight = 13 + object panel_all: TPanel + Left = 0 + Top = 100 + Width = 692 + Height = 300 + BevelOuter = bvNone + TabOrder = 0 + object Splitter2: TSplitter + Left = 360 + Top = 0 + Width = 8 + Height = 300 + AutoSnap = False + Beveled = True + MinSize = 360 + end + object panel_left: TPanel + Left = 0 + Top = 0 + Width = 360 + Height = 300 + Cursor = crDrag + Align = alLeft + BevelOuter = bvNone + TabOrder = 0 + object Splitter1: TSplitter + Left = 0 + Top = 241 + Width = 360 + Height = 8 + Cursor = crVSplit + Align = alTop + AutoSnap = False + Beveled = True + MinSize = 75 + OnMoved = Splitter1Moved + end + object panel_files: TPanel + Left = 0 + Top = 0 + Width = 360 + Height = 241 + Align = alTop + BevelOuter = bvNone + TabOrder = 0 + object btn_extractconvert: TButton + Left = 1 + Top = 220 + Width = 358 + Height = 20 + Caption = 'Convert and extract file' + Enabled = False + TabOrder = 0 + WordWrap = True + OnClick = btn_extractconvertClick + end + object list_files: TListBox + Left = 0 + Top = 0 + Width = 360 + Height = 218 + Align = alTop + Font.Charset = DEFAULT_CHARSET + Font.Color = clWindowText + Font.Height = -11 + Font.Name = 'Fixedsys' + Font.Style = [] + ItemHeight = 15 + ParentFont = False + TabOrder = 1 + OnClick = list_filesDblClick + OnDblClick = list_filesDblClick + end + end + object list_extensions: TListBox + Left = 0 + Top = 249 + Width = 360 + Height = 51 + Align = alClient + Font.Charset = DEFAULT_CHARSET + Font.Color = clWindowText + Font.Height = -11 + Font.Name = 'Fixedsys' + Font.Style = [] + ItemHeight = 15 + ParentFont = False + Sorted = True + TabOrder = 1 + OnClick = list_extensionsClick + OnDblClick = list_extensionsClick + end + end + object panel_file: TPanel + Left = 368 + Top = 0 + Width = 324 + Height = 300 + Align = alClient + BevelOuter = bvNone + TabOrder = 1 + object lbl_fileinfo: TLabel + Left = 0 + Top = 0 + Width = 324 + Height = 49 + Align = alTop + AutoSize = False + end + object edit_data: TMemo + Left = 0 + Top = 49 + Width = 324 + Height = 251 + Align = alClient + Font.Charset = DEFAULT_CHARSET + Font.Color = clWindowText + Font.Height = -13 + Font.Name = 'Fixedsys' + Font.Style = [] + ParentFont = False + ReadOnly = True + ScrollBars = ssVertical + TabOrder = 0 + WordWrap = False + end + end + end + object group_progress: TGroupBox + Left = 296 + Top = 480 + Width = 297 + Height = 57 + Caption = 'Extracting...' + TabOrder = 1 + Visible = False + object lbl_progress: TLabel + Left = 10 + Top = 36 + Width = 279 + Height = 18 + AutoSize = False + end + object progress: TProgressBar + Left = 8 + Top = 16 + Width = 217 + Height = 17 + Step = 1 + TabOrder = 0 + end + object btn_extractcancel: TButton + Left = 232 + Top = 16 + Width = 57 + Height = 33 + Caption = 'Cancel' + TabOrder = 1 + OnClick = btn_extractcancelClick + end + end + object statbar: TStatusBar + Left = 0 + Top = 565 + Width = 692 + Height = 17 + BiDiMode = bdLeftToRight + Panels = < + item + Text = 'Current .dat: -' + Width = 500 + end + item + Text = 'Files: -' + Width = 90 + end + item + Text = 'Extensions: -' + Width = 100 + end> + ParentBiDiMode = False + end + object fopen: TOpenDialog + Filter = 'Oni-Dat-Files|*.dat|Oni-Sep-Files (MAC)|*.sep' + Left = 64 + Top = 120 + end + object menu: TMainMenu + AutoHotkeys = maManual + Left = 224 + object menu_main: TMenuItem + Caption = '&Main' + object menu_loaddat: TMenuItem + Caption = '&Select .dat-file ...' + OnClick = menu_loaddatClick + end + object menu_sep1: TMenuItem + Caption = '-' + end + object menu_exit: TMenuItem + Caption = '&Exit' + OnClick = menu_exitClick + end + end + object menu_extract: TMenuItem + Caption = '&Extract/Convert' + Enabled = False + object menu_extractfile: TMenuItem + Caption = 'Convert and extract current &file' + OnClick = menu_extractfileClick + end + object menu_extractlist: TMenuItem + Caption = 'Convert and extract all files currently in &list' + OnClick = menu_extractlistClick + end + object menu_extractall: TMenuItem + Caption = 'Convert and extract &all files' + OnClick = menu_extractallClick + end + end + object menu_tools: TMenuItem + Caption = '&Tools' + Enabled = False + object menu_preview: TMenuItem + Caption = '&Preview Window ...' + OnClick = menu_previewClick + end + object menu_binedit: TMenuItem + Caption = '&Binary .dat editor ...' + Enabled = False + OnClick = menu_bineditClick + end + object menu_txmpreplace: TMenuItem + Caption = '&TXMP replacer ...' + OnClick = menu_txmpreplaceClick + end + end + end +end Index: /oup/releases/0.15a/Unit1_main.pas =================================================================== --- /oup/releases/0.15a/Unit1_main.pas (revision 21) +++ /oup/releases/0.15a/Unit1_main.pas (revision 21) @@ -0,0 +1,427 @@ +UNIT Unit1_main; +INTERFACE +USES + Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, + Dialogs, StdCtrls, StrUtils, Clipbrd, ExtCtrls, ComCtrls, Menus, + Unit2_functions, Unit3_data, Unit5_preview, Unit7_txmpreplace, Unit8_binedit; + +TYPE + TForm1 = Class(TForm) + panel_all: TPanel; + panel_left: TPanel; + Splitter1: TSplitter; + panel_files: TPanel; + btn_extractconvert: TButton; + list_files: TListBox; + list_extensions: TListBox; + Splitter2: TSplitter; + fopen: TOpenDialog; + group_progress: TGroupBox; + progress: TProgressBar; + lbl_progress: TLabel; + menu: TMainMenu; + menu_main: TMenuItem; + menu_exit: TMenuItem; + menu_preview: TMenuItem; + btn_extractcancel: TButton; + menu_tools: TMenuItem; + menu_txmpreplace: TMenuItem; + menu_extract: TMenuItem; + menu_extractfile: TMenuItem; + menu_extractlist: TMenuItem; + menu_extractall: TMenuItem; + menu_loaddat: TMenuItem; + menu_sep1: TMenuItem; + menu_binedit: TMenuItem; + statbar: TStatusBar; + panel_file: TPanel; + edit_data: TMemo; + lbl_fileinfo: TLabel; + PROCEDURE menu_extractallClick(Sender: TObject); + PROCEDURE menu_extractlistClick(Sender: TObject); + PROCEDURE menu_extractfileClick(Sender: TObject); + PROCEDURE menu_bineditClick(Sender: TObject); + PROCEDURE menu_loaddatClick(Sender: TObject); + PROCEDURE menu_txmpreplaceClick(Sender: TObject); + PROCEDURE menu_exitClick(Sender: TObject); + PROCEDURE btn_extractcancelClick(Sender: TObject); + PROCEDURE menu_previewClick(Sender: TObject); + PROCEDURE Splitter1Moved(Sender: TObject); + PROCEDURE FormClose(Sender: TObject; var Action: TCloseAction); + PROCEDURE btn_hexcopyClick(Sender: TObject); + PROCEDURE list_extensionsClick(Sender: TObject); + PROCEDURE FormResize(Sender: TObject); + PROCEDURE btn_extractconvertClick(Sender: TObject); + PROCEDURE FormCreate(Sender: TObject); + PROCEDURE list_filesDblClick(Sender: TObject); + PROCEDURE btn_loadClick(Sender: TObject); + PRIVATE + PUBLIC + END; + +VAR + Form1: TForm1; + +IMPLEMENTATION +{$R *.dfm} + +PROCEDURE DoAfterLoadOfADat; + VAR + i:LongWord; + txt:Text; + temp4:LongWord; + temp2:Word; + temp1:Byte; + BEGIN + IF NOT DirectoryExists(GetExtractPath) THEN + CreateDir(GetExtractPath); + AssignFile(txt,GetExtractPath+'\___TXMP-FILES___.TXT'); + ReWrite(txt); + FOR i:=0 TO dat_header.Extensions-1 DO BEGIN + IF (dat_extensionsmap[i].Extension[3]='T') AND + (dat_extensionsmap[i].Extension[2]='X') AND + (dat_extensionsmap[i].Extension[1]='M') AND + (dat_extensionsmap[i].Extension[0]='P') THEN BEGIN + WriteLn(txt, FormatNumber(dat_extensionsmap[i].ExtCount,4,'0')+' TXMP-Files'); + Break; + END; + END; + WriteLn(txt,'FileName'+#9+'MipMap'+#9+'Depth'+#9+'ImgX'+#9+'ImgY'+#9+'StoreT'); + FOR i:=0 TO dat_header.Files-1 DO BEGIN + IF dat_files[i].Extension='TXMP' THEN BEGIN + Write(txt,dat_files[i].FileName+#9); + LoadDatFilePart(i,$88,1,@temp1); + Write(txt,IntToHex(temp1,2)+#9); + LoadDatFilePart(i,$89,1,@temp1); + Write(txt,IntToHex(temp1,2)+#9); + LoadDatFilePart(i,$8C,2,@temp2); + Write(txt,IntToHex(temp2,4)+#9); + LoadDatFilePart(i,$8E,2,@temp2); + Write(txt,IntToHex(temp2,4)+#9); + LoadDatFilePart(i,$90,1,@temp1); + Write(txt,IntToHex(temp1,2)+#9); + WriteLn(txt,''); + END; + END; + CloseFile(txt); + + IF NOT DirectoryExists(GetExtractPath) THEN + CreateDir(GetExtractPath); + AssignFile(txt,GetExtractPath+'\___TXAN-FILES___.TXT'); + ReWrite(txt); + FOR i:=0 TO dat_header.Extensions-1 DO BEGIN + IF (dat_extensionsmap[i].Extension[3]='T') AND + (dat_extensionsmap[i].Extension[2]='X') AND + (dat_extensionsmap[i].Extension[1]='A') AND + (dat_extensionsmap[i].Extension[0]='N') THEN BEGIN + WriteLn(txt, FormatNumber(dat_extensionsmap[i].ExtCount,4,'0')+' TXAN-Files'); + Break; + END; + END; + WriteLn(txt,'FileName'+#9+'Loopspeed'+#9+'Unknown'+#9+'Links'); + FOR i:=0 TO dat_header.Files-1 DO BEGIN + IF dat_files[i].Extension='TXAN' THEN BEGIN + Write(txt,dat_files[i].FileName+#9); + LoadDatFilePart(i,$14,2,@temp2); + Write(txt,IntToHex(temp2,4)+#9); + LoadDatFilePart(i,$16,2,@temp2); + Write(txt,IntToHex(temp2,4)+#9); + LoadDatFilePart(i,$1C,4,@temp4); + Write(txt,IntToHex(temp4,8)+#9); + WriteLn(txt,''); + END; + END; + CloseFile(txt); + END; + +PROCEDURE LoadDat; + VAR i:LongWord; + BEGIN + Form1.fopen.InitialDir:=AppSettings.DatPath; + IF Form1.fopen.Execute THEN BEGIN + Form1.Caption:='Oni Un/Packer '+version+' ('+ExtractFileName(Form1.fopen.FileName)+')'; + AppSettings.DatPath:=ExtractFilepath(Form1.fopen.FileName); + Form1.list_files.Items.Clear; + Form1.list_extensions.Items.Clear; + IF LoadDatInfos(Form1.fopen.FileName) THEN BEGIN + Form1.list_extensions.Items.Add('_All files: '+FormatNumber(dat_header.Files,4,' ')); + FOR i:=0 TO dat_header.Extensions-1 DO BEGIN + WITH dat_extensionsmap[i] DO BEGIN + Form1.list_extensions.Items.Add( + Extension[3]+Extension[2]+Extension[1]+Extension[0]+': '+ + FormatNumber(ExtCount,4,' '));{+' (Ident: 0x'+ + IntToHex(Ident[7],2)+IntToHex(Ident[6],2)+IntToHex(Ident[5],2)+IntToHex(Ident[4],2)+IntToHex(Ident[3],2)+IntToHex(Ident[2],2)+IntToHex(Ident[1],2)+IntToHex(Ident[0],2)+')');} + END; + END; + Form1.list_extensions.ItemIndex:=0; + Form1.list_extensionsClick(Form1); + Form1.list_files.ItemIndex:=0; + Form1.list_filesDblClick(Form1); + Form1.statbar.Panels.Items[0].Text:='Current .dat: '+dat_FileName; + Form1.statbar.Panels.Items[1].Text:='Files: '+IntToStr(dat_header.Files); + Form1.statbar.Panels.Items[2].Text:='Extensions: '+IntToStr(dat_header.Extensions); + Form1.menu_tools.Enabled:=True; + Form1.menu_extract.Enabled:=True; + Form1.btn_extractconvert.Enabled:=True; + + Form7.RecreateTXMPlist; + + DoAfterLoadOfADat; + + END ELSE BEGIN + ShowMessage('Error while loading the file:'+CrLf+Form1.fopen.FileName+CrLf+'Perhaps not an Oni-.dat-file?'); + END; + END; + END; + +PROCEDURE TForm1.btn_loadClick(Sender: TObject); + BEGIN + LoadDat; + END; + +PROCEDURE TForm1.list_filesDblClick(Sender: TObject); + VAR + id:LongWord; + temp:Tdata; + BEGIN + id:=StrToInt(MidStr(list_files.Items.Strings[list_files.ItemIndex],1,5)); + lbl_fileinfo.Caption:= + 'Filename: '+dat_files[id].FileName+CrLf+ + 'Size: '+FormatFileSize(dat_files[id].Size)+' ('+IntToStr(dat_files[id].Size)+' Bytes)'+CrLf+ + 'Address in .dat: 0x'+IntTohex(dat_files[id].DatAddr,8); + IF (dat_files[id].FileType AND $02)=0 THEN BEGIN + temp:=LoadDatFile(id); + edit_data.Text:=CreateHexString(temp,False); + Form5.ShowPreview(id); + END ELSE BEGIN + edit_data.Text:='Zero byte file.'+CrLf+'Oni will take the data for this file of level0_final.dat/raw'; + END; + END; + +PROCEDURE TForm1.FormCreate(Sender: TObject); + BEGIN + Form1.Caption:='Oni Un/Packer '+version; + Form1.FormResize(Form1); + + panel_all.Align:=alClient; + + IF FileExists(ExtractFilepath(Application.EXEname)+'\oniunpacker.ini') THEN BEGIN + AssignFile(AppSettingsFile,ExtractFilepath(Application.EXEname)+'\oniunpacker.ini'); + Reset(AppSettingsFile); + Read(AppSettingsFile,AppSettings); + CloseFile(AppSettingsFile); + END ELSE BEGIN + AppSettings.DatPath:='D:\Spiele\Oni\GameDataFolder'; + AppSettings.ExtractPath:='C:\Dokumente und Einstellungen\Administrator\Desktop'; + END; + END; + +PROCEDURE TForm1.btn_extractconvertClick(Sender: TObject); + BEGIN + Form1.menu_extractfileClick(Form1); + END; + +PROCEDURE TForm1.FormResize(Sender: TObject); + CONST + MinWidth:Integer=750; + MinHeight:Integer=500; + BEGIN + IF NOT group_progress.Visible THEN BEGIN + IF Form1.Width0 THEN Inc(errors); + IF (i MOD 25)=0 THEN BEGIN + lbl_progress.Caption:=IntToStr(i)+'/'+IntToStr(progress.Max); + progress.Position:=i; + Application.ProcessMessages; + IF btn_extractcancel.Caption='Cancel_' THEN BEGIN + btn_extractcancel.Caption:='Cancel'; + Break; + END; + END; + END; + IF errors>0 THEN + ShowMessage(IntToStr(errors)+' errors encountered.'); + + group_progress.Visible:=False; + Form1.Width:=oldwidth; + Form1.Height:=oldheight; + Form1.WindowState:=oldstate; + //FOR i:=0 TO menu.ComponentCount DO menu.Items.Items[i].Enabled:=True; + panel_all.Visible:=True; + END; + +PROCEDURE TForm1.menu_extractallClick(Sender: TObject); + VAR + i:LongWord; + errors:LongWord; + oldwidth,oldheight:Integer; + oldstate:TWindowState; + BEGIN + panel_all.Visible:=False; + group_progress.Visible:=True; + //FOR i:=0 TO menu.ComponentCount DO menu.Items.Items[i].Enabled:=False; + oldwidth:=Form1.Width; + oldheight:=Form1.Height; + oldstate:=Form1.WindowState; + Form1.WindowState:=wsNormal; + Form1.Width:=400; + Form1.Height:=120; + group_progress.Left:=0; + group_progress.Top:=0; + group_progress.Width:=Form1.Width-8; + progress.Width:=group_progress.Width-80; + progress.Max:=dat_header.files; + btn_extractcancel.Left:=group_progress.Width-65; + btn_extractcancel.Caption:='Cancel'; + btn_extractcancel.SetFocus; + + errors:=0; + FOR i:=0 TO High(dat_files) DO BEGIN + IF ExportFile(i,True)>0 THEN Inc(errors); + IF (i MOD 25)=0 THEN BEGIN + lbl_progress.Caption:=IntToStr(i)+'/'+IntToStr(dat_header.Files); + progress.Position:=i; + Application.ProcessMessages; + IF btn_extractcancel.Caption='Cancel_' THEN BEGIN + btn_extractcancel.Caption:='Cancel'; + Break; + END; + END; + END; + IF errors>0 THEN + ShowMessage(IntToStr(errors)+' errors encountered.'); + + group_progress.Visible:=False; + Form1.Width:=oldwidth; + Form1.Height:=oldheight; + Form1.WindowState:=oldstate; + //FOR i:=0 TO menu.ComponentCount DO menu.Items.Items[i].Enabled:=True; + panel_all.Visible:=True; + END; + +END. Index: /oup/releases/0.15a/Unit2_functions.pas =================================================================== --- /oup/releases/0.15a/Unit2_functions.pas (revision 21) +++ /oup/releases/0.15a/Unit2_functions.pas (revision 21) @@ -0,0 +1,205 @@ +UNIT Unit2_functions; +INTERFACE +USES Classes, SysUtils, StrUtils, Math, SQLiteTable3, Unit3_data, Unit4_Exporters; + +FUNCTION LoadDatInfos(filename:String):Boolean; +FUNCTION LoadDatFile(fileid:LongWord):Tdata; +FUNCTION LoadDatFilePart(fileid,offset,size:LongWord; target:Pointer):Boolean; +FUNCTION LoadRawFilePart(address,size:LongWord; target:Pointer):Boolean; +FUNCTION FormatNumber(value:LongWord; width:Byte; leadingzeros:Char):String; +FUNCTION FormatFileSize(size:LongWord):String; +FUNCTION CreateHexString(data:Tdata; HexOnly:Boolean):String; +FUNCTION ExportFile(fileid:LongWord; convert:Boolean):Integer; +FUNCTION GetWinFileName(fileid:LongWord; substring:String):String; +FUNCTION GetExtractPath:String; + + + +IMPLEMENTATION + + +FUNCTION LoadDatInfos(filename:String):Boolean; + VAR i:LongWord; + dat_file:TFileStream; + BEGIN + Result:=True; + dat_filename:=filename; + raw_filename:=MidStr(filename,1,Length(filename)-3)+'raw'; + dat_file:=TFileStream.Create(filename, fmOpenRead); + dat_file.Read(dat_header,SizeOf(dat_header)); + FOR i:=0 TO High(dat_header.Ident) DO + IF dat_header.Ident[i]<>header_ident1[i] THEN BEGIN + Result:=False; + Exit; + END; +{ FOR i:=0 TO High(dat_header.Ident2) DO + IF dat_header.Ident2[i]<>header_ident2[i] THEN BEGIN + Result:=False; + Exit; + END; +} + SetLength(dat_filesmap,dat_header.Files); + SetLength(dat_files,dat_header.Files); + FOR i:=0 TO dat_header.Files-1 DO dat_file.Read(dat_filesmap[i],SizeOf(dat_filesmap[i])); + FOR i:=0 TO dat_header.Files-1 DO BEGIN + dat_files[i].Extension:=dat_filesmap[i].Extension; + dat_files[i].Extension:=ReverseString(dat_files[i].Extension); + dat_files[i].Size:=dat_filesmap[i].FileSize; + dat_files[i].FileType:=dat_filesmap[i].FileType; + dat_files[i].DatAddr:=dat_filesmap[i].DataAddr-8+dat_header.DataAddr; + IF (dat_filesmap[i].FileType AND $01)=0 THEN BEGIN + dat_file.Seek(dat_filesmap[i].NameAddr+dat_header.NamesAddr,soFromBeginning); + SetLength(dat_files[i].Name,100); + dat_file.Read(dat_files[i].Name[1],100); + dat_files[i].Name:=MidStr(dat_files[i].Name,1+4,Pos(#0,dat_files[i].Name)-1-4); + END ELSE BEGIN + dat_files[i].Name:=''; + END; + dat_files[i].FileName:=FormatNumber(i,5,'0')+'-'+dat_files[i].Name+'.'+dat_files[i].Extension; + END; + dat_file.Seek($40+dat_header.Files*$14,soFromBeginning); + SetLength(dat_namedfilesmap,dat_header.NamedFiles); + FOR i:=0 TO dat_header.NamedFiles-1 DO dat_file.Read(dat_namedfilesmap[i],SizeOf(dat_namedfilesmap[i])); + + dat_file.Seek($40+dat_header.Files*$14+dat_header.NamedFiles*$8,soFromBeginning); + SetLength(dat_extensionsmap,dat_header.Extensions); + FOR i:=0 TO dat_header.Extensions-1 DO dat_file.Read(dat_extensionsmap[i],SizeOf(dat_extensionsmap[i])); + + dat_file.Free; + END; + + +FUNCTION LoadDatFile(fileid:LongWord):Tdata; + VAR dat_file:TFileStream; + BEGIN + dat_file:=TFileStream.Create(dat_filename, fmOpenRead); + dat_file.Seek(dat_files[fileid].DatAddr,soFromBeginning); + SetLength(Result,dat_files[fileid].Size); + dat_file.Read(Result[0],dat_files[fileid].Size); + dat_file.Free; + END; + + +FUNCTION LoadDatFilePart(fileid,offset,size:LongWord; target:Pointer):Boolean; + VAR dat_file:TFileStream; + BEGIN + dat_file:=TFileStream.Create(dat_filename, fmOpenRead); + Result:=True; + dat_file.Seek(dat_files[fileid].DatAddr+offset,soFromBeginning); + dat_file.Read(target^,size); + dat_file.Free; + END; + + +FUNCTION LoadRawFilePart(address,size:LongWord; target:Pointer):Boolean; + VAR + filestream:TFileStream; + BEGIN + Result:=True; + filestream:=TFileStream.Create(AnsiReplaceStr(dat_filename,'.dat','.raw'),fmOpenRead); + filestream.Seek(address,soFromBeginning); + filestream.Read(target^,size); + filestream.Free; + END; + + +FUNCTION FormatNumber(value:LongWord; width:Byte; leadingzeros:Char):String; + BEGIN + Result:=AnsiReplaceStr(Format('%'+IntToStr(width)+'u',[value]),' ',leadingzeros); + END; + + +FUNCTION FormatFileSize(size:LongWord):String; + BEGIN + IF size>=1024*1024*1024 THEN BEGIN + Result:=FloatToStrF(size/1024/1024/1024,ffFixed,5,1)+' GB'; + END ELSE BEGIN + IF size>=1024*1024 THEN BEGIN + Result:=FloatToStrF(size/1024/1024,ffFixed,5,1)+' MB'; + END ELSE BEGIN + IF size>=1024 THEN BEGIN + Result:=FloatToStrF(size/1024,ffFixed,5,1)+' KB'; + END ELSE BEGIN + Result:=IntToStr(size)+' B'; + END; + END; + END; + END; + + +FUNCTION CreateHexString(data:Tdata; HexOnly:Boolean):String; + VAR + string_build,ascii_version:String; + i:LongWord; + BEGIN + string_build:=''; + ascii_version:=''; + FOR i:=0 TO High(data) DO BEGIN + IF NOT HexOnly THEN + IF (i MOD 16)=0 THEN + string_build:=string_build+'0x'+IntToHex(i,6)+' '; + string_build:=string_build+IntToHex(data[i],2); + IF NOT HexOnly THEN BEGIN + IF data[i]>=32 THEN ascii_version:=ascii_version+Chr(data[i]) + ELSE ascii_version:=ascii_version+'.'; + IF ((i+1) MOD 2)=0 THEN string_build:=string_build+#32; + IF ((i+1) MOD 16)=0 THEN BEGIN + string_build:=string_build+#32+ascii_version+CrLf; + ascii_version:=''; + END; + END; + END; + Result:=string_build; + END; + + +FUNCTION ExportFile(fileid:LongWord; convert:Boolean):Integer; + VAR + i:Byte; + BEGIN + Result:=export_noerror; + + //ExportDefFileHeader(fileid); + + IF (dat_files[fileid].FileType AND $02)=0 THEN BEGIN + //ExportDatFile(fileid); + + FOR i:=1 TO Length(ExportHandlers)+1 DO BEGIN + IF i<=Length(ExportHandlers) THEN BEGIN + IF ExportHandlers[i].Ext=dat_files[fileid].Extension THEN BEGIN + IF ExportHandlers[i].needed THEN BEGIN + CASE ExportHandlers[i].Handler(fileid,convert) OF + 0: Result:=0; + ELSE + Result:=export_handlererror; + END; + END; + Break; + END; + END ELSE BEGIN + Result:=export_nohandler; + END; + END; + END; + END; + + +FUNCTION GetWinFileName(fileid:LongWord; substring:String):String; + VAR + name:String; + BEGIN + name:=dat_files[fileid].Name; + name:=AnsiReplaceStr(name,'\','__'); + name:=AnsiReplaceStr(name,'/','__'); + name:=AnsiReplaceStr(name,'>','__'); + name:=AnsiReplaceStr(name,'<','__'); + Result:=FormatNumber(fileid,5,'0')+'-'+name+'.'+substring+'.'+dat_files[fileid].Extension; + END; + +FUNCTION GetExtractPath:String; + BEGIN + Result:=ExtractFilePath(dat_filename)+'\extracted_'+ExtractFileName(dat_filename); + END; + + +END. Index: /oup/releases/0.15a/Unit3_data.pas =================================================================== --- /oup/releases/0.15a/Unit3_data.pas (revision 21) +++ /oup/releases/0.15a/Unit3_data.pas (revision 21) @@ -0,0 +1,84 @@ +UNIT Unit3_data; +INTERFACE +USES Classes; + +CONST + version:String='v0.15a'; + CrLf:String[2]=#13+#10; + +TYPE + Tdata=Array OF Byte; + Theader=PACKED RECORD + Ident:Array[0..$13] OF Byte; + Files:LongWord; + NamedFiles:LongWord; + Extensions:LongWord; + DataAddr:LongWord; + DataSize:LongWord; + NamesAddr:LongWord; + NamesSize:LongWord; + Ident2:Array[0..$F] OF Byte; + END; + Tfilesmap=Array OF PACKED RECORD + Extension:Array[0..$3] OF Char; + DataAddr:LongWord; + NameAddr:LongWord; + FileSize:LongWord; + FileType:LongWord; + END; + Tfiles=Array OF PACKED RECORD + FileName:String; + Extension:String[4]; + Name:String; + Size:LongWord; + FileType:LongWord; + DatAddr:LongWord; + END; + + Tnamedfilesmap=Array OF PACKED RECORD + FileNumber:LongWord; + blubb:LongWord; + END; + Textensionsmap=Array OF PACKED RECORD + Ident:Array[0..$7] OF Byte; + Extension:Array[0..$3] OF Char; + ExtCount:LongWord; + END; + + TAppSettings=RECORD + DatPath:String[250]; + ExtractPath:String[250]; + END; + + TExportHandlers=RECORD + Ext:String[4]; + needed:Boolean; + Handler:Function(fileid:LongWord; convert:Boolean):Integer; + END; + +VAR + dat_filename:String=''; + raw_filename:String=''; + dat_header:Theader; + dat_filesmap:Tfilesmap; + dat_files:Tfiles; + dat_namedfilesmap:Tnamedfilesmap; + dat_extensionsmap:Textensionsmap; + AppSettings:TAppSettings; + AppSettingsFile:File OF TAppSettings; + +CONST + header_ident1:Array[0..$13] OF Byte= + ($1F,$27,$DC,$33,$DF,$BC,$03,$00,$31,$33,$52,$56,$40,$00,$14,$00,$10,$00,$08,$00); + header_ident2:Array[0..$F] OF Byte= + ($99,$CF,$40,$00,$90,$4F,$63,$00,$F4,$55,$5F,$00,$90,$4F,$63,$00); + + export_noerror:Integer=0; + export_nohandler:Integer=1; + export_handlererror:Integer=2; + export_error:Integer=3; + +IMPLEMENTATION + +END. + Index: /oup/releases/0.15a/Unit4_Exporters.pas =================================================================== --- /oup/releases/0.15a/Unit4_Exporters.pas (revision 21) +++ /oup/releases/0.15a/Unit4_Exporters.pas (revision 21) @@ -0,0 +1,181 @@ +UNIT Unit4_Exporters; +INTERFACE +USES Classes, StrUtils, SysUtils, Math, Unit3_data, Unit6_imgfuncs; + +PROCEDURE ExportDefLine(fileid:LongWord; line:String; create:Boolean); +PROCEDURE ExportDefFileHeader(fileid:LongWord); +PROCEDURE ExportDatFile(fileid:LongWord); + +FUNCTION ExportTRAC(fileid:LongWord; convert:Boolean):Integer; +FUNCTION ExportTXAN(fileid:LongWord; convert:Boolean):Integer; +FUNCTION ExportTXMB(fileid:LongWord; convert:Boolean):Integer; +FUNCTION ExportTXMP(fileid:LongWord; convert:Boolean):Integer; +VAR + ExportHandlers:Array[1..5] OF TExportHandlers=( + (Ext:'ABNA'; needed:False), + //(Ext:'AGDB'; needed:False), + (Ext:'TRAC'; needed:True; Handler:ExportTRAC), + (Ext:'TXAN'; needed:True; Handler:ExportTXAN), + (Ext:'TXMB'; needed:True; Handler:ExportTXMB), + (Ext:'TXMP'; needed:True; Handler:ExportTXMP) + ); + + + +IMPLEMENTATION +USES Unit2_functions; + +PROCEDURE ExportDefLine(fileid:LongWord; line:String; create:Boolean); + VAR + filestream:TFileStream; + data:Tdata; + i:LongWord; + BEGIN + SetLength(data,Length(line)+2); + FOR i:=1 TO Length(line) DO + data[i-1]:=Ord(line[i]); + data[Length(line)]:=13; + data[Length(line)+1]:=10; + { + IF create THEN + filestream:=TFileStream.Create(GetExtractPath+'\'+GetWinFileName(fileid,'_DEF_'),fmCreate) + ELSE BEGIN + filestream:=TFileStream.Create(GetExtractPath+'\'+GetWinFileName(fileid,'_DEF_'),fmOpenWrite); + filestream.Seek(0,soFromEnd); + END; + filestream.Write(data[0],Length(data)); + filestream.Free; + } + END; + +PROCEDURE ExportDefFileHeader(fileid:LongWord); + BEGIN + IF NOT DirectoryExists(GetExtractPath) THEN + CreateDir(GetExtractPath); + WITH dat_files[fileid] DO + ExportDefLine(fileid,FormatNumber(fileid,5,'0')+':'+Name+':'+Extension+':'+IntToHex(Size,8)+':'+IntToHex(FileType,8),True); + END; + +PROCEDURE ExportDatFile(fileid:LongWord); + VAR + filestream:TFileStream; + data:Tdata; + BEGIN + data:=LoadDatFile(fileid); + filestream:=TFileStream.Create(GetExtractPath+'\'+GetWinFileName(fileid,'_DAT_'),fmCreate); + filestream.Write(data[0],Length(data)); + filestream.Free; + END; + + +FUNCTION ExportTRAC; + VAR + link:LongWord; + linkcount:Word; + i:LongWord; + BEGIN + Result:=export_noerror; + + LoadDatFilePart(fileid,$18,SizeOf(link),@link); + link:=link DIV 256; + ExportDefLine(fileid,FormatNumber(0,4,'0')+':LINKtoTRAC:'+FormatNumber(link,5,'0')+':'+dat_files[link].Name+':'+dat_files[link].Extension,False); + + LoadDatFilePart(fileid,$1E,SizeOf(linkcount),@linkcount); + ExportDefLine(fileid,'TRAMLINKS:'+FormatNumber(linkcount,4,'0'),False); + FOR i:=1 TO linkcount DO BEGIN + LoadDatFilePart(fileid,$20+(i-1)*12+8,SizeOf(link),@link); + link:=link DIV 256; + ExportDefLine(fileid,FormatNumber(i,4,'0')+':LINKtoTRAM:'+FormatNumber(link,5,'0')+':'+dat_files[link].Name+':'+dat_files[link].Extension,False); + END; + END; + +FUNCTION ExportTXAN; + VAR + loop_speed,unknown:Word; + linkcount:LongWord; + link:LongWord; + i:Byte; + BEGIN + Result:=export_noerror; + + LoadDatFilePart(fileid,$14,SizeOf(loop_speed),@loop_speed); + LoadDatFilePart(fileid,$16,SizeOf(unknown),@unknown); + ExportDefLine(fileid,'LOOPSPEED:'+FormatNumber(loop_speed,2,'0'),False); + ExportDefLine(fileid,'UNKNOWN:'+FormatNumber(unknown,2,'0'),False); + + LoadDatFilePart(fileid,$1C,SizeOf(linkcount),@linkcount); + ExportDefLine(fileid,'TXMPLINKS:'+FormatNumber(linkcount,4,'0'),False); + FOR i:=0 TO linkcount-1 DO BEGIN + LoadDatFilePart(fileid,$20+i*4,SizeOf(link),@link); + link:=link DIV 256; + IF link=0 THEN link:=fileid-1; + ExportDefLine(fileid,FormatNumber(i,4,'0')+':LINKtoTXMP:'+FormatNumber(link,5,'0')+':'+dat_files[link].Name+':'+dat_files[link].Extension,False); + END; + END; + +FUNCTION ExportTXMB; + VAR + filestream:TFileStream; + subfile:Byte; + linkcount:LongWord; + link:LongWord; + width,height:Word; + cols,rows:Word; + i:Byte; + img:TImgPackage; + data:Tdata; + BEGIN + Result:=export_noerror; + subfile:=1; + + LoadDatFilePart(fileid,$10,SizeOf(width),@width); + LoadDatFilePart(fileid,$12,SizeOf(height),@height); + LoadDatFilePart(fileid,$18,SizeOf(cols),@cols); + LoadDatFilePart(fileid,$1A,SizeOf(rows),@rows); + ExportDefLine(fileid,'WIDTH:'+FormatNumber(width,4,'0'),False); + ExportDefLine(fileid,'HEIGHT:'+FormatNumber(height,4,'0'),False); + ExportDefLine(fileid,'COLS:'+FormatNumber(cols,2,'0'),False); + ExportDefLine(fileid,'ROWS:'+FormatNumber(rows,2,'0'),False); + + LoadDatFilePart(fileid,$1C,SizeOf(linkcount),@linkcount); + ExportDefLine(fileid,'TXMPLINKS:'+FormatNumber(linkcount,4,'0'),False); + FOR i:=0 TO linkcount-1 DO BEGIN + LoadDatFilePart(fileid,$20+i*4,SizeOf(link),@link); + link:=link DIV 256; + IF link=0 THEN link:=fileid-1; + ExportDefLine(fileid,FormatNumber(i,4,'0')+':LINKtoTXMP:'+FormatNumber(link,5,'0')+':'+dat_files[link].Name+':'+dat_files[link].Extension,False); + END; + + IF convert THEN BEGIN + img:=LoadTXMBconnected(fileid); + data:=ImgdataToBmp(img.imgx,img.imgy,img.imgdepth,img.storetype,img.imgdata); + filestream:=TFileStream.Create(GetExtractPath+'\'+GetWinFileName(fileid,FormatNumber(subfile,2,'0')+'-ImgData')+'.bmp',fmCreate); + filestream.Write(data[0],Length(data)); + filestream.Free; + END; + END; + +FUNCTION ExportTXMP; + VAR + filestream:TFileStream; + subfile:Byte; + img:TImgPackage; + BEGIN + Result:=export_noerror; + subfile:=1; + + img:=LoadImgData(fileid); + { + filestream:=TFileStream.Create(GetExtractPath+'\'+GetWinFileName(fileid,FormatNumber(subfile,2,'0')+'-ImgData'),fmCreate); + filestream.Write(img.imgdata[0],Length(img.imgdata)); + filestream.Free; + } + IF convert THEN BEGIN + img.imgdata:=ImgdataToBMP(img.imgx,img.imgy,img.imgdepth,img.storetype,img.imgdata); + filestream:=TFileStream.Create(GetExtractPath+'\'+GetWinFileName(fileid,FormatNumber(subfile,2,'0')+'-ImgData')+'.bmp',fmCreate); + filestream.Write(img.imgdata[0],Length(img.imgdata)); + filestream.Free; + END; + END; + +END. Index: /oup/releases/0.15a/Unit5_preview.dfm =================================================================== --- /oup/releases/0.15a/Unit5_preview.dfm (revision 21) +++ /oup/releases/0.15a/Unit5_preview.dfm (revision 21) @@ -0,0 +1,74 @@ +object Form5: TForm5 + Left = 0 + Top = 0 + Width = 435 + Height = 348 + BorderStyle = bsSizeToolWin + Caption = 'Preview' + Color = clBtnFace + Font.Charset = DEFAULT_CHARSET + Font.Color = clWindowText + Font.Height = -11 + Font.Name = 'Tahoma' + Font.Style = [] + FormStyle = fsStayOnTop + OldCreateOrder = False + OnCloseQuery = FormCloseQuery + OnCreate = FormCreate + OnResize = FormResize + PixelsPerInch = 96 + TextHeight = 13 + object img: TImage + Left = 0 + Top = 20 + Width = 427 + Height = 304 + Align = alClient + end + object panel_buttons: TPanel + Left = 0 + Top = 0 + Width = 427 + Height = 20 + Align = alTop + BevelOuter = bvNone + TabOrder = 0 + Visible = False + OnResize = panel_buttonsResize + object btn_dec: TButton + Left = 0 + Top = 0 + Width = 20 + Height = 20 + Caption = '-' + Enabled = False + TabOrder = 0 + OnClick = btn_decClick + end + object btn_startstop: TButton + Left = 21 + Top = 0 + Width = 80 + Height = 20 + Caption = 'Stop automatic' + TabOrder = 1 + OnClick = btn_startstopClick + end + object btn_inc: TButton + Left = 102 + Top = 0 + Width = 20 + Height = 20 + Caption = '+' + Enabled = False + TabOrder = 2 + OnClick = btn_incClick + end + end + object timer: TTimer + Enabled = False + OnTimer = timerTimer + Left = 72 + Top = 48 + end +end Index: /oup/releases/0.15a/Unit5_preview.pas =================================================================== --- /oup/releases/0.15a/Unit5_preview.pas (revision 21) +++ /oup/releases/0.15a/Unit5_preview.pas (revision 21) @@ -0,0 +1,183 @@ +UNIT Unit5_preview; +INTERFACE +USES + Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, + Dialogs, Math, ExtCtrls, Unit2_functions, Unit3_data, Unit4_exporters, Unit6_imgfuncs, + StdCtrls; + +TYPE + TForm5 = Class(TForm) + img: TImage; + timer: TTimer; + panel_buttons: TPanel; + btn_dec: TButton; + btn_startstop: TButton; + btn_inc: TButton; + PROCEDURE btn_incClick(Sender: TObject); + PROCEDURE btn_decClick(Sender: TObject); + PROCEDURE FormResize(Sender: TObject); + PROCEDURE btn_startstopClick(Sender: TObject); + PROCEDURE panel_buttonsResize(Sender: TObject); + PROCEDURE timerTimer(Sender: TObject); + PROCEDURE FormCreate(Sender: TObject); + PROCEDURE FormCloseQuery(Sender: TObject; var CanClose: Boolean); + PROCEDURE ShowPreview(fileid:LongWord); + PRIVATE + PUBLIC + END; + +VAR + Form5: TForm5; + +IMPLEMENTATION +{$R *.dfm} +USES Unit1_main; +VAR + memstreams:Array OF TMemoryStream; + actualimg:Byte; + _fileid:LongWord; + +PROCEDURE PreviewTXMB; + VAR + data:Tdata; + img:TImgPackage; + BEGIN + SetLength(memstreams,1); + img:=LoadTXMBconnected(_fileid); + data:=ImgdataToBmp(img.imgx,img.imgy,img.imgdepth,img.storetype,img.imgdata); + + memstreams[0].Clear; + memstreams[0].Write(data[0],Length(data)); + memstreams[0].Seek(0,soFromBeginning); + + Form5.img.Picture.Bitmap.LoadFromStream(memstreams[0]); + END; + +PROCEDURE PreviewTXMP; + VAR + data:Tdata; + img:TImgPackage; + BEGIN + SetLength(memstreams,1); + img:=LoadImgData(_fileid); + data:=ImgdataToBmp(img.imgx,img.imgy,img.imgdepth,img.storetype,img.imgdata); + + memstreams[0].Clear; + memstreams[0].Write(data[0],Length(data)); + memstreams[0].Seek(0,soFromBeginning); + + Form5.img.Picture.Bitmap.LoadFromStream(memstreams[0]); + END; + +PROCEDURE PreviewTXAN; + VAR + loop_speed:Word; + linkcount:LongWord; + link:LongWord; + i:Byte; + data:Tdata; + img:TImgPackage; + BEGIN + LoadDatFilePart(_fileid,$14,SizeOf(loop_speed),@loop_speed); + LoadDatFilePart(_fileid,$1C,SizeOf(linkcount),@linkcount); + SetLength(memstreams,linkcount); + FOR i:=0 TO linkcount-1 DO BEGIN + LoadDatFilePart(_fileid,$20+i*4,SizeOf(link),@link); + link:=link DIV 256; + IF link=0 THEN link:=_fileid-1; + memstreams[i]:=TMemoryStream.Create; + img:=LoadImgData(link); + data:=ImgdataToBmp(img.imgx,img.imgy,img.imgdepth,img.storetype,img.imgdata); + memstreams[i].Clear; + memstreams[i].Write(data[0],Length(data)); + memstreams[i].Seek(0,soFromBeginning); + END; + actualimg:=254; + Form5.timer.Interval:=Floor(loop_speed*(1/60)*1000); + Form5.timer.Enabled:=False; + Form5.btn_startstopClick(Form5); + Form5.panel_buttons.Visible:=True; + END; + +PROCEDURE TForm5.ShowPreview(fileid:LongWord); + BEGIN + _fileid:=fileid; + Form5.timer.Enabled:=False; + Form5.panel_buttons.Visible:=False; + Form5.Caption:='Preview '+dat_files[_fileid].FileName; + IF dat_files[fileid].Extension='TXAN' THEN PreviewTXAN; + IF dat_files[fileid].Extension='TXMB' THEN PreviewTXMB; + IF dat_files[fileid].Extension='TXMP' THEN PreviewTXMP; + END; + +PROCEDURE TForm5.FormCloseQuery(Sender: TObject; var CanClose: Boolean); + BEGIN + CanClose:=False; + Form5.Visible:=False; + END; + +PROCEDURE TForm5.FormCreate(Sender: TObject); + BEGIN + SetLength(memstreams,1); + memstreams[0]:=TMemoryStream.Create; + Form5.Width:=260; + Form5.Height:=300; + END; + +PROCEDURE TForm5.timerTimer(Sender: TObject); + BEGIN + Inc(actualimg); + IF actualimg>=Length(memstreams) THEN actualimg:=0; + Form5.img.Picture.Bitmap.LoadFromStream(memstreams[actualimg]); + memstreams[actualimg].Seek(0,soFromBeginning); + Form5.Caption:='Preview '+dat_files[_fileid].FileName+' ('+IntToStr(actualimg+1)+'/'+IntToStr(Length(memstreams))+')'; + END; + +PROCEDURE TForm5.panel_buttonsResize(Sender: TObject); + BEGIN + btn_startstop.Width:=panel_buttons.Width-45; + btn_inc.Left:=panel_buttons.Width-23; + END; + +PROCEDURE TForm5.btn_startstopClick(Sender: TObject); + BEGIN + Form5.timer.Enabled:=NOT Form5.timer.Enabled; + Form5.btn_dec.Enabled:=NOT Form5.timer.Enabled; + Form5.btn_inc.Enabled:=NOT Form5.timer.Enabled; + IF Form5.timer.Enabled THEN + Form5.btn_startstop.Caption:='Stop automatic' + ELSE + Form5.btn_startstop.Caption:='Start automatic'; + END; + +PROCEDURE TForm5.FormResize(Sender: TObject); + BEGIN + IF Form5.Width>=150 THEN BEGIN + END ELSE Form5.Width:=150; + IF Form5.Height>=150 THEN BEGIN + END ELSE Form5.Height:=150; + END; + +PROCEDURE TForm5.btn_decClick(Sender: TObject); + BEGIN + IF actualimg>0 THEN + Dec(actualimg) + ELSE + actualimg:=High(memstreams); + Form5.Caption:='Preview '+dat_files[_fileid].FileName+' ('+IntToStr(actualimg+1)+'/'+IntToStr(Length(memstreams))+')'; + Form5.img.Picture.Bitmap.LoadFromStream(memstreams[actualimg]); + memstreams[actualimg].Seek(0,soFromBeginning); + END; + +PROCEDURE TForm5.btn_incClick(Sender: TObject); + BEGIN + IF actualimg0) THEN BEGIN + Inc(row_orig); + IF (row_orig MOD 2)=0 THEN BEGIN + Inc(row); + col:=0; + END; + END; + IF (row_orig MOD 2)=0 THEN BEGIN + IF (i MOD 2)=0 THEN BEGIN + FOR j:=0 TO (imgdepth DIV 8)-1 DO + temparray[((row*(oldx DIV 2))+col)*(imgdepth DIV 8)+j]:=data[i*2+j]; + Inc(col); + END; + END; + END; + Result:=temparray; + END; + + +FUNCTION RevertImage(imgx,imgy,imgdepth:LongWord; imgdata:Tdata):Tdata; + VAR + x,y,i:LongWord; + BEGIN + SetLength(Result,imgx*imgy*(imgdepth DIV 8)); + FOR y:=0 TO imgy-1 DO + FOR x:=0 TO imgx-1 DO + FOR i:=0 TO (imgdepth DIV 8)-1 DO + Result[((imgx*(imgy-1-y)+x)*(imgdepth DIV 8))+i]:= + imgdata[(imgx*y+x)*(imgdepth DIV 8)+i]; + END; + + +FUNCTION DecompressImage(imgx,imgy:LongWord; imgdata:Tdata):Tdata; + TYPE + Tcolor=RECORD + RGBb:Byte; + RGBg:Byte; + RGBr:Byte; + RGBa:Byte; + END; + VAR + i,j,x,y:LongWord; + color:Array[1..4] OF Tcolor; + pixel:Array[1..16] OF Byte; + BEGIN + x:=0; + y:=0; + SetLength(Result,imgx*imgy*4); + FOR i:=0 TO ((imgx*imgy) DIV 16)-1 DO BEGIN + Color[1].RGBb:=Floor(((imgdata[(i*8)+0]+imgdata[(i*8)+1]*256) AND $001F) / $001F * 255); + Color[1].RGBg:=Floor(((imgdata[(i*8)+0]+imgdata[(i*8)+1]*256) AND $07E0) / $07E0 * 255); + Color[1].RGBr:=Floor(((imgdata[(i*8)+0]+imgdata[(i*8)+1]*256) AND $F800) / $F800 * 255); + Color[1].RGBa:=255; + Color[2].RGBb:=Floor(((imgdata[(i*8)+2]+imgdata[(i*8)+3]*256) AND $001F) / $001F * 255); + Color[2].RGBg:=Floor(((imgdata[(i*8)+2]+imgdata[(i*8)+3]*256) AND $07E0) / $07E0 * 255); + Color[2].RGBr:=Floor(((imgdata[(i*8)+2]+imgdata[(i*8)+3]*256) AND $F800) / $F800 * 255); + Color[2].RGBa:=255; + Color[3].RGBb:=Floor( Color[1].RGBb/3*2 + Color[2].RGBb/3 ); + Color[3].RGBg:=Floor( Color[1].RGBg/3*2 + Color[2].RGBg/3 ); + Color[3].RGBr:=Floor( Color[1].RGBr/3*2 + Color[2].RGBr/3 ); + Color[3].RGBa:=255; + Color[4].RGBb:=Floor( Color[1].RGBb/3 + Color[2].RGBb/3*2 ); + Color[4].RGBg:=Floor( Color[1].RGBg/3 + Color[2].RGBg/3*2 ); + Color[4].RGBr:=Floor( Color[1].RGBr/3 + Color[2].RGBr/3*2 ); + Color[4].RGBa:=255; + Pixel[1]:=Floor( (imgdata[(i*8)+4] AND $C0) / $40 + 1 ); + Pixel[2]:=Floor( (imgdata[(i*8)+4] AND $30) / $10 + 1 ); + Pixel[3]:=Floor( (imgdata[(i*8)+4] AND $0C) / $04 + 1 ); + Pixel[4]:=Floor( (imgdata[(i*8)+4] AND $03) + 1 ); + Pixel[5]:=Floor( (imgdata[(i*8)+5] AND $C0) / $40 + 1 ); + Pixel[6]:=Floor( (imgdata[(i*8)+5] AND $30) / $10 + 1 ); + Pixel[7]:=Floor( (imgdata[(i*8)+5] AND $0C) / $04 + 1 ); + Pixel[8]:=Floor( (imgdata[(i*8)+5] AND $03) + 1 ); + Pixel[9]:=Floor( (imgdata[(i*8)+6] AND $C0) / $40 + 1 ); + Pixel[10]:=Floor( (imgdata[(i*8)+6] AND $30) / $10 + 1 ); + Pixel[11]:=Floor( (imgdata[(i*8)+6] AND $0C) / $04 + 1 ); + Pixel[12]:=Floor( (imgdata[(i*8)+6] AND $03) + 1 ); + Pixel[13]:=Floor( (imgdata[(i*8)+7] AND $C0) / $40 + 1 ); + Pixel[14]:=Floor( (imgdata[(i*8)+7] AND $30) / $10 + 1 ); + Pixel[15]:=Floor( (imgdata[(i*8)+7] AND $0C) / $04 + 1 ); + Pixel[16]:=Floor( (imgdata[(i*8)+7] AND $03) + 1 ); + FOR j:=0 TO 3 DO BEGIN + Result[((y+3)*imgx+x+j)*3+0]:=Color[Pixel[16-j]].RGBb; + Result[((y+3)*imgx+x+j)*3+1]:=Color[Pixel[16-j]].RGBg; + Result[((y+3)*imgx+x+j)*3+2]:=Color[Pixel[16-j]].RGBr; + END; + FOR j:=0 TO 3 DO BEGIN + Result[((y+2)*imgx+x+j)*3+0]:=Color[Pixel[12-j]].RGBb; + Result[((y+2)*imgx+x+j)*3+1]:=Color[Pixel[12-j]].RGBg; + Result[((y+2)*imgx+x+j)*3+2]:=Color[Pixel[12-j]].RGBr; + END; + FOR j:=0 TO 3 DO BEGIN + Result[((y+1)*imgx+x+j)*3+0]:=Color[Pixel[8-j]].RGBb; + Result[((y+1)*imgx+x+j)*3+1]:=Color[Pixel[8-j]].RGBg; + Result[((y+1)*imgx+x+j)*3+2]:=Color[Pixel[8-j]].RGBr; + END; + FOR j:=0 TO 3 DO BEGIN + Result[((y+0)*imgx+x+j)*3+0]:=Color[Pixel[4-j]].RGBb; + Result[((y+0)*imgx+x+j)*3+1]:=Color[Pixel[4-j]].RGBg; + Result[((y+0)*imgx+x+j)*3+2]:=Color[Pixel[4-j]].RGBr; + END; + x:=x+4; + IF x=imgx THEN BEGIN + y:=y+4; + x:=0; + END; + END; + END; + + +FUNCTION ImgdataToBmp(imgx,imgy,imgdepth,storetype:LongWord; imgdata:Tdata):Tdata; + CONST BMPheader:Array[0..53] OF Byte= + ($42,$4D,0,0,0,0,0,0,0,0,54,0,0,0, + 40,0,0,0,0,0,0,0,0,0,0,0,1,0,$18,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0); + VAR + i,x,y:LongWord; + BEGIN + CASE storetype OF + 0: BEGIN + SetLength(Result,imgx*imgy*3); + FOR y:=0 TO imgy-1 DO BEGIN + FOR x:=0 TO imgx-1 DO BEGIN + Result[((imgx*y+x)*3)+0]:=Floor( ( (imgdata[(imgx*y+x)*2]+imgdata[(imgx*y+x)*2+1]*256) AND $000F ) / $000F * 255); + Result[((imgx*y+x)*3)+1]:=Floor( ( (imgdata[(imgx*y+x)*2]+imgdata[(imgx*y+x)*2+1]*256) AND $00F0 ) / $00F0 * 255); + Result[((imgx*y+x)*3)+2]:=Floor( ( (imgdata[(imgx*y+x)*2]+imgdata[(imgx*y+x)*2+1]*256) AND $0F00 ) / $0F00 * 255); + END; + END; + END; + 1,2: BEGIN + SetLength(Result,imgx*imgy*3); + FOR y:=0 TO imgy-1 DO BEGIN + FOR x:=0 TO imgx-1 DO BEGIN + Result[((imgx*y+x)*3)+0]:=Floor( ( (imgdata[(imgx*y+x)*2]+imgdata[(imgx*y+x)*2+1]*256) AND $001F ) / $001F * 255); + Result[((imgx*y+x)*3)+1]:=Floor( ( (imgdata[(imgx*y+x)*2]+imgdata[(imgx*y+x)*2+1]*256) AND $03E0 ) / $03E0 * 255); + Result[((imgx*y+x)*3)+2]:=Floor( ( (imgdata[(imgx*y+x)*2]+imgdata[(imgx*y+x)*2+1]*256) AND $7C00 ) / $7C00 * 255); + END; + END; + END; + 8: BEGIN + SetLength(Result,imgx*imgy*3); + FOR y:=0 TO imgy-1 DO BEGIN + FOR x:=0 TO imgx-1 DO BEGIN + Result[((imgx*y+x)*3)+0]:=imgdata[(imgx*y+x)*4+0]; + Result[((imgx*y+x)*3)+1]:=imgdata[(imgx*y+x)*4+1]; + Result[((imgx*y+x)*3)+2]:=imgdata[(imgx*y+x)*4+2]; + END; + END; + END; + 9: BEGIN + Result:=DecompressImage(imgx,imgy,imgdata); + END; + END; + Result:=RevertImage(imgx,imgy,24,Result); + SetLength(Result,imgx*imgy*3+54); + FOR i:=High(Result)-54 DOWNTO 0 DO Result[i+54]:=Result[i]; + + FOR i:=0 TO High(BMPheader) DO Result[i]:=BMPheader[i]; + Result[2]:=((imgx*imgy*3+54) AND $000000FF); + Result[3]:=((imgx*imgy*3+54) AND $0000FF00) DIV $100; + Result[4]:=((imgx*imgy*3+54) AND $00FF0000) DIV $10000; + Result[5]:=((imgx*imgy*3+54) AND $FF000000) DIV $1000000; + Result[18]:=(imgx AND $000000FF) DIV $1; + Result[19]:=(imgx AND $0000FF00) DIV $100; + Result[20]:=(imgx AND $00FF0000) DIV $10000; + Result[21]:=(imgx AND $FF000000) DIV $1000000; + Result[22]:=(imgy AND $000000FF) DIV $1; + Result[23]:=(imgy AND $0000FF00) DIV $100; + Result[24]:=(imgy AND $00FF0000) DIV $10000; + Result[25]:=(imgy AND $FF000000) DIV $1000000; + Result[34]:=((imgx*imgy*3) AND $000000FF) DIV $1; + Result[35]:=((imgx*imgy*3) AND $0000FF00) DIV $100; + Result[36]:=((imgx*imgy*3) AND $00FF0000) DIV $10000; + Result[37]:=((imgx*imgy*3) AND $FF000000) DIV $1000000; + END; + +FUNCTION BmpToImgdata(bmpdata:Tdata; _32bit:Boolean):TImgPackage; + VAR + x,y:LongWord; + r24,g24,b24:Word; + r16,g16,b16:Word; + gesamt:Word; + BEGIN + Result.imgdepth:=0; + IF NOT((bmpdata[00]=$42) AND (bmpdata[01]=$4D)) THEN BEGIN + ShowMessage('Not a standard 24bit bitmap'); + Exit; + END; + IF NOT(bmpdata[10]=54) THEN BEGIN + ShowMessage('Imagedata has to start at 0x54'); + Exit; + END; + IF NOT(bmpdata[14]=40) THEN BEGIN + ShowMessage('Second bitmap header has to have 40 bytes'); + Exit; + END; + IF NOT(bmpdata[28]=24) THEN BEGIN + ShowMessage('Bitmap has to have 24bits'); + Exit; + END; + IF NOT(bmpdata[30]=0) THEN BEGIN + ShowMessage('Bitmap has to be uncompressed'); + Exit; + END; + Result.imgx:=bmpdata[18]+bmpdata[19]*256+bmpdata[20]*256*256+bmpdata[21]*256*256*256; + Result.imgy:=bmpdata[22]+bmpdata[23]*256+bmpdata[24]*256*256+bmpdata[25]*256*256*256; + IF _32bit THEN BEGIN + Result.imgdepth:=32; + Result.storetype:=8; + END ELSE BEGIN + Result.imgdepth:=16; + Result.storetype:=1; + END; + + SetLength(Result.imgdata,Result.imgx*Result.imgy*Result.imgdepth DIV 8); + IF _32bit THEN BEGIN + FOR y:=0 TO Result.imgy-1 DO BEGIN + FOR x:=0 TO Result.imgx-1 DO BEGIN + Result.imgdata[((Result.imgx*y+x)*4)+0]:=bmpdata[54+(Result.imgx*y+x)*3+0]; + Result.imgdata[((Result.imgx*y+x)*4)+1]:=bmpdata[54+(Result.imgx*y+x)*3+1]; + Result.imgdata[((Result.imgx*y+x)*4)+2]:=bmpdata[54+(Result.imgx*y+x)*3+2]; + Result.imgdata[((Result.imgx*y+x)*4)+3]:=0; + END; + END; + END ELSE BEGIN + FOR y:=0 TO Result.imgy-1 DO BEGIN + FOR x:=0 TO Result.imgx-1 DO BEGIN + r24:=bmpdata[54+(Result.imgx*y+x)*3+0]; + g24:=bmpdata[54+(Result.imgx*y+x)*3+1]; + b24:=bmpdata[54+(Result.imgx*y+x)*3+2]; + r16:=(Ceil(r24*$001F/255)) AND $001F; + g16:=(Ceil(g24*$03E0/255)) AND $03E0; + b16:=(Ceil(b24*$7C00/255)) AND $7C00; + gesamt:=r16+g16+b16; + Result.imgdata[((Result.imgx*y+x)*2)+0]:=gesamt AND $00FF; + Result.imgdata[((Result.imgx*y+x)*2)+1]:=(gesamt AND $FF00) DIV 256; + END; + END; + END; + + Result.imgdata:=RevertImage(Result.imgx,Result.imgy,Result.imgdepth,Result.imgdata); + END; + +FUNCTION LoadTXMBconnected(fileid:LongWord):TImgPackage; + VAR + i,x,y,x2,y2,pixelid,imgid:LongWord; + rows,cols:Word; + linkcount:LongWord; + link:LongWord; + single_image:TImgPackage; + images_decoded:Array OF TImgPackage; + x_start,y_start:LongWord; + BEGIN + LoadDatFilePart(fileid,$10,SizeOf(Result.imgx),@Result.imgx); + LoadDatFilePart(fileid,$12,SizeOf(Result.imgy),@Result.imgy); + LoadDatFilePart(fileid,$18,SizeOf(cols),@cols); + LoadDatFilePart(fileid,$1A,SizeOf(rows),@rows); + LoadDatFilePart(fileid,$1C,SizeOf(linkcount),@linkcount); + SetLength(images_decoded,linkcount); + FOR i:=0 TO linkcount-1 DO BEGIN + LoadDatFilePart(fileid,$20+i*4,SizeOf(link),@link); + link:=link DIV 256; + single_image:=LoadImgData(link); + images_decoded[i]:=BmpToImgdata(ImgdataToBmp(single_image.imgx,single_image.imgy,single_image.imgdepth,single_image.storetype,single_image.imgdata),False); + END; + SetLength(Result.imgdata,Result.imgx*Result.imgy*2); + FOR y:=0 TO rows-1 DO BEGIN + FOR x:=0 TO cols-1 DO BEGIN + imgid:=y*cols+x; + x_start:=0; + y_start:=0; + FOR i:=0 TO x DO IF i=400 THEN BEGIN + END ELSE Form7.Width:=400; + IF Form7.Height>=350 THEN BEGIN + END ELSE Form7.Height:=350; + END; + +PROCEDURE TForm7.list_txmpClick(Sender: TObject); + VAR + id:LongWord; + data:Tdata; + img:TImgPackage; + mem:TMemoryStream; + fadingbyte,depthbyte,storebyte:Byte; + BEGIN + id:=StrToInt(MidStr(list_txmp.Items.Strings[list_txmp.ItemIndex],1,5)); + + LoadDatFilePart(id,$88,SizeOf(fadingbyte),@fadingbyte); + LoadDatFilePart(id,$89,SizeOf(depthbyte),@depthbyte); + LoadDatFilePart(id,$90,SizeOf(storebyte),@storebyte); + Form7.check_fading.Checked:=(fadingbyte AND $01)>0; + Form7.check_transparency.Checked:=(depthbyte AND $04)>0; + Form7.check_32bit.Checked:=(storebyte=8); + + img:=LoadImgData(id); + data:=ImgdataToBmp(img.imgx,img.imgy,img.imgdepth,img.storetype,img.imgdata); + + mem:=TMemoryStream.Create; + mem.Write(data[0],Length(data)); + mem.Seek(0,soFromBeginning); + Form7.image_txmppreview.Picture.Bitmap.LoadFromStream(mem); + mem.Free; + + Form7.group_bmpselect.Enabled:=True; + END; + +PROCEDURE TForm7.btn_loadClick(Sender: TObject); + VAR + bmpfile:TFileStream; + mem:TMemoryStream; + BEGIN + IF opend.Execute THEN BEGIN + bmpfile:=TFileStream.Create(opend.FileName, fmOpenRead); + SetLength(actual_bmpdata,bmpfile.Size); + bmpfile.Read(actual_bmpdata[0],bmpfile.Size); + bmpfile.Free; + + mem:=TMemoryStream.Create; + mem.Write(actual_bmpdata[0],Length(actual_bmpdata)); + mem.Seek(0,soFromBeginning); + Form7.image_bmppreview.Picture.Bitmap.LoadFromStream(mem); + mem.Free; + + Form7.group_options.Enabled:=True; + END; + END; + +PROCEDURE TForm7.btn_replaceClick(Sender: TObject); + VAR + id:LongWord; + imgpkg:TImgPackage; + rawfile:TFileStream; + datfile:TFileStream; + dataddr:LongWord; + old_rawaddr,new_rawaddr:LongWord; + oldwidth,oldheight:Word; + oldstore,olddepth,oldfading:Byte; + oldsize:LongWord; + newsize:LongWord; + datword,datbyte:Word; + BEGIN + IF Form7.list_txmp.ItemIndex>=0 THEN BEGIN + imgpkg:=BmpToImgdata(actual_bmpdata,check_32bit.Checked); + datfile:=TFileStream.Create(dat_filename,fmOpenReadWrite); + + id:=StrToInt(MidStr(list_txmp.Items.Strings[list_txmp.ItemIndex],1,5)); + dataddr:=dat_files[id].dataddr; + datfile.Seek(dataddr+$8C,soFromBeginning); + datfile.Read(oldwidth,2); + datfile.Seek(dataddr+$8E,soFromBeginning); + datfile.Read(oldheight,2); + datfile.Seek(dataddr+$88,soFromBeginning); + datfile.Read(oldfading,1); + datfile.Seek(dataddr+$89,soFromBeginning); + datfile.Read(olddepth,1); + datfile.Seek(dataddr+$90,soFromBeginning); + datfile.Read(oldstore,1); + datfile.Seek(dataddr+$9C,soFromBeginning); + datfile.Read(old_rawaddr,4); + IF (oldwidth<>imgpkg.imgx) OR (oldheight<>imgpkg.imgy) THEN BEGIN + IF MessageBox(Form7.Handle, + PChar('Current image and new image have different size'+CrLf+ + '(Current: '+IntToStr(oldwidth)+'x'+IntToStr(oldheight)+ + ' - New: '+IntToStr(imgpkg.imgx)+'x'+IntToStr(imgpkg.imgy)+')'+CrLf+ + 'Replace anyways?'), + PChar(list_txmp.Items.Strings[list_txmp.ItemIndex]), + MB_YESNO)=IDNO THEN Exit; + END; + + rawfile:=TFileStream.Create(raw_filename,fmOpenReadWrite); + + CASE oldstore OF + 9: oldsize:=GetImageDataSize(oldwidth,oldheight,8,(oldfading AND $01)>0); + 0,1,2: oldsize:=GetImageDataSize(oldwidth,oldheight,16,(oldfading AND $01)>0); + 8: oldsize:=GetImageDataSize(oldwidth,oldheight,32,(oldfading AND $01)>0); + ELSE + oldsize:=0; + END; + IF check_32bit.Checked THEN + newsize:=GetImageDataSize(imgpkg.imgx,imgpkg.imgy,32,Form7.check_fading.Checked) + ELSE + newsize:=GetImageDataSize(imgpkg.imgx,imgpkg.imgy,16,Form7.check_fading.Checked); + + IF newsize<=oldsize THEN + new_rawaddr:=old_rawaddr + ELSE + new_rawaddr:=rawfile.Size; + + datbyte:=$00; + IF Form7.check_fading.Checked THEN datbyte:=datbyte OR $01; + datfile.Seek(dataddr+$88,soFromBeginning); + datfile.Write(datbyte,2); + datbyte:=$10; + IF Form7.check_transparency.Checked THEN datbyte:=datbyte OR $04; + datfile.Seek(dataddr+$89,soFromBeginning); + datfile.Write(datbyte,2); + datfile.Seek(dataddr+$8C,soFromBeginning); + datfile.Write(imgpkg.imgx,2); + datfile.Seek(dataddr+$8E,soFromBeginning); + datfile.Write(imgpkg.imgy,2); + IF check_32bit.Checked THEN + datbyte:=$08 + ELSE + datbyte:=$01; + datfile.Seek(dataddr+$90,soFromBeginning); + datfile.Write(datbyte,2); + datfile.Seek(dataddr+$9C,soFromBeginning); + datfile.Write(new_rawaddr,4); + datfile.Free; + + IF Form7.check_fading.Checked THEN BEGIN + imgpkg.imgdata:=CreateFadedImage(imgpkg); + END; + + rawfile.Seek(new_rawaddr,soFromBeginning); + rawfile.Write(imgpkg.imgdata[0],Length(imgpkg.imgdata)); + rawfile.Free; + + ShowMessage('TXMP-image replaced'); + END; + END; + +END. Index: /oup/releases/0.15a/Unit8_binedit.dfm =================================================================== --- /oup/releases/0.15a/Unit8_binedit.dfm (revision 21) +++ /oup/releases/0.15a/Unit8_binedit.dfm (revision 21) @@ -0,0 +1,51 @@ +object Form8: TForm8 + Left = 0 + Top = 0 + AutoScroll = False + BorderStyle = bsSizeToolWin + Caption = 'Form8' + ClientHeight = 617 + ClientWidth = 698 + Color = clBtnFace + Font.Charset = DEFAULT_CHARSET + Font.Color = clWindowText + Font.Height = -11 + Font.Name = 'Tahoma' + Font.Style = [] + OldCreateOrder = False + OnCloseQuery = FormCloseQuery + OnCreate = FormCreate + PixelsPerInch = 96 + TextHeight = 13 + object grid: TWrapGrid + Left = 136 + Top = 8 + Width = 561 + Height = 273 + BevelInner = bvNone + BevelOuter = bvNone + ColCount = 18 + DefaultColWidth = 22 + DefaultRowHeight = 18 + FixedColor = clWindow + RowCount = 1 + FixedRows = 0 + Font.Charset = DEFAULT_CHARSET + Font.Color = clWindowText + Font.Height = -11 + Font.Name = 'Fixedsys' + Font.Style = [] + Options = [goEditing] + ParentFont = False + ScrollBars = ssVertical + TabOrder = 0 + end + object ListBox1: TListBox + Left = 0 + Top = 296 + Width = 161 + Height = 313 + ItemHeight = 13 + TabOrder = 1 + end +end Index: /oup/releases/0.15a/Unit8_binedit.pas =================================================================== --- /oup/releases/0.15a/Unit8_binedit.pas (revision 21) +++ /oup/releases/0.15a/Unit8_binedit.pas (revision 21) @@ -0,0 +1,44 @@ +UNIT Unit8_binedit; +INTERFACE +USES + Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, + Dialogs, Grids, Wrapgrid, StdCtrls; + +TYPE + TForm8 = Class(TForm) + grid: TWrapGrid; + ListBox1: TListBox; + PROCEDURE FormCloseQuery(Sender: TObject; var CanClose: Boolean); + PROCEDURE FormCreate(Sender: TObject); + PRIVATE + PUBLIC + END; + +VAR + Form8: TForm8; + +IMPLEMENTATION +{$R *.dfm} + +PROCEDURE TForm8.FormCreate(Sender: TObject); + BEGIN + grid.RowCount:=1; + grid.ColCount:=18; + grid.FixedCols:=1; + grid.FixedRows:=0; + + grid.Cells[0,0]:='0x000000'; + grid.ColWidths[0]:=80; + grid.ColWidths[17]:=140; + grid.Cells[1,0]:='00'; + grid.Cells[2,0]:='FF'; + grid.Cells[17,0]:='..##############'; + END; + +PROCEDURE TForm8.FormCloseQuery(Sender: TObject; var CanClose: Boolean); + BEGIN + CanClose:=False; + Form8.Visible:=False; + END; + +END. Index: /oup/releases/0.16a/OniUnPacker.bdsproj =================================================================== --- /oup/releases/0.16a/OniUnPacker.bdsproj (revision 21) +++ /oup/releases/0.16a/OniUnPacker.bdsproj (revision 21) @@ -0,0 +1,171 @@ + + + + + + + + + + + + OniUnPacker.dpr + + + 7.0 + + + 8 + 0 + 1 + 1 + 0 + 0 + 1 + 1 + 1 + 0 + 0 + 1 + 0 + 1 + 1 + 1 + 0 + 0 + 0 + 0 + 0 + 1 + 0 + 1 + 1 + 1 + True + True + WinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE; + + False + + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + False + False + False + True + True + True + + + 0 + 0 + 1 + False + False + False + 16384 + 1048576 + 4194304 + + + + + + + + + xmlrtl;rtl;vcl;vclie;inet;inetdbbde;inetdbxpress;vclx;IndySystem;IndyCore;dbrtl;dsnap;soaprtl;IndyProtocols;bdertl;vcldbx;vcldb;webdsnap;websnap;vclactnband;GridPackd2005;TWrapGrid;Package1;A406_R70;CoolTrayIcon_D6plus + + + False + + + + + + False + + + + + + False + + + False + False + 1 + 0 + 0 + 0 + False + False + False + False + False + 1031 + 1252 + + + + + 1.0.0.0 + + + + + + 1.0.0.0 + + + (untitled) + Borland Web Wizard Package + + + Index: /oup/releases/0.16a/OniUnPacker.cfg =================================================================== --- /oup/releases/0.16a/OniUnPacker.cfg (revision 21) +++ /oup/releases/0.16a/OniUnPacker.cfg (revision 21) @@ -0,0 +1,38 @@ +-$A8 +-$B- +-$C+ +-$D+ +-$E- +-$F- +-$G+ +-$H+ +-$I+ +-$J- +-$K- +-$L+ +-$M- +-$N+ +-$O+ +-$P+ +-$Q- +-$R- +-$S- +-$T- +-$U- +-$V+ +-$W- +-$X+ +-$YD +-$Z1 +-cg +-AWinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE; +-H+ +-W+ +-M +-$M16384,1048576 +-K$00400000 +-LE"C:\Dokumente und Einstellungen\Administrator\Eigene Dateien\Borland Studio Projects\Bpl" +-LN"C:\Dokumente und Einstellungen\Administrator\Eigene Dateien\Borland Studio Projects\Bpl" +-w-UNSAFE_TYPE +-w-UNSAFE_CODE +-w-UNSAFE_CAST Index: /oup/releases/0.16a/OniUnPacker.dpr =================================================================== --- /oup/releases/0.16a/OniUnPacker.dpr (revision 21) +++ /oup/releases/0.16a/OniUnPacker.dpr (revision 21) @@ -0,0 +1,23 @@ +PROGRAM OniUnPacker; +uses + Forms, + Unit1_main in 'Unit1_main.pas' {Form1}, + Unit2_functions in 'Unit2_functions.pas', + Unit3_data in 'Unit3_data.pas', + Unit4_Exporters in 'Unit4_Exporters.pas', + Unit5_preview in 'Unit5_preview.pas' {Form5}, + Unit6_imgfuncs in 'Unit6_imgfuncs.pas', + Unit7_txmpreplace in 'Unit7_txmpreplace.pas' {Form7}, + Unit8_binedit in 'Unit8_binedit.pas' {Form8}; + +{$R *.res} + +BEGIN + Application.Initialize; + Application.Title:='Oni Un/Packer'; + Application.CreateForm(TForm1, Form1); + Application.CreateForm(TForm5, Form5); + Application.CreateForm(TForm7, Form7); + Application.CreateForm(TForm8, Form8); + Application.Run; +END. Index: /oup/releases/0.16a/SQLite3.pas =================================================================== --- /oup/releases/0.16a/SQLite3.pas (revision 21) +++ /oup/releases/0.16a/SQLite3.pas (revision 21) @@ -0,0 +1,120 @@ +unit SQLite3; + +{ + Simplified interface for SQLite. + Updated for Sqlite 3 by Tim Anderson (tim@itwriting.com) + Note: NOT COMPLETE for version 3, just minimal functionality + Adapted from file created by Pablo Pissanetzky (pablo@myhtpc.net) + which was based on SQLite.pas by Ben Hochstrasser (bhoc@surfeu.ch) +} + +interface + +const +// Return values for sqlite3_exec() and sqlite3_step() + +SQLITE_OK = 0; // Successful result +SQLITE_ERROR = 1; // SQL error or missing database +SQLITE_INTERNAL = 2; // An internal logic error in SQLite +SQLITE_PERM = 3 ; // Access permission denied +SQLITE_ABORT = 4; // Callback routine requested an abort +SQLITE_BUSY = 5; // The database file is locked +SQLITE_LOCKED = 6; // A table in the database is locked +SQLITE_NOMEM = 7; // A malloc() failed +SQLITE_READONLY = 8; // Attempt to write a readonly database +SQLITE_INTERRUPT = 9; // Operation terminated by sqlite3_interrupt() +SQLITE_IOERR = 10; // Some kind of disk I/O error occurred +SQLITE_CORRUPT = 11; // The database disk image is malformed +SQLITE_NOTFOUND = 12; // (Internal Only) Table or record not found +SQLITE_FULL = 13; // Insertion failed because database is full +SQLITE_CANTOPEN = 14; // Unable to open the database file +SQLITE_PROTOCOL = 15; // Database lock protocol error +SQLITE_EMPTY = 16; // Database is empty +SQLITE_SCHEMA = 17; // The database schema changed +SQLITE_TOOBIG = 18; // Too much data for one row of a table +SQLITE_CONSTRAINT = 19; // Abort due to contraint violation +SQLITE_MISMATCH = 20; // Data type mismatch +SQLITE_MISUSE = 21; // Library used incorrectly +SQLITE_NOLFS = 22; // Uses OS features not supported on host +SQLITE_AUTH = 23; // Authorization denied +SQLITE_FORMAT = 24; // Auxiliary database format error +SQLITE_RANGE = 25; // 2nd parameter to sqlite3_bind out of range +SQLITE_NOTADB = 26; // File opened that is not a database file +SQLITE_ROW = 100; // sqlite3_step() has another row ready +SQLITE_DONE = 101; // sqlite3_step() has finished executing + +SQLITE_INTEGER = 1; +SQLITE_FLOAT = 2; +SQLITE_TEXT = 3; +SQLITE_BLOB = 4; +SQLITE_NULL = 5; + +type +TSQLiteDB = Pointer; +TSQLiteResult = ^PChar; +TSQLiteStmt = Pointer; + +function SQLite3_Open (dbname: PChar; var db: TSqliteDB): integer; cdecl; external 'sqlite3.dll' name 'sqlite3_open'; +function SQLite3_Close (db: TSQLiteDB): integer; cdecl; external 'sqlite3.dll' name 'sqlite3_close'; +function SQLite3_Exec (db: TSQLiteDB; SQLStatement: PChar; CallbackPtr: Pointer; Sender: TObject; var ErrMsg: PChar): integer; cdecl; external 'sqlite3.dll' name 'sqlite3_exec'; +function SQLite3_Version (): PChar; cdecl; external 'sqlite3.dll' name 'sqlite3_libversion'; +function SQLite3_ErrMsg (db: TSQLiteDB): PChar; cdecl; external 'sqlite3.dll' name 'sqlite3_errmsg'; +function SQLite3_ErrCode (db: TSQLiteDB): integer; cdecl; external 'sqlite3.dll' name 'sqlite3_errcode'; +procedure SQlite3_Free (P: PChar); cdecl; external 'sqlite3.dll' name 'sqlite3_free'; +function SQLite3_GetTable (db: TSQLiteDB; SQLStatement: PChar; var ResultPtr: TSQLiteResult; var RowCount: Cardinal; var ColCount: Cardinal; var ErrMsg: PChar): integer; cdecl; external 'sqlite3.dll' name 'sqlite3_get_table'; +procedure SQLite3_FreeTable (Table:TSQLiteResult ); cdecl; external 'sqlite3.dll' name 'sqlite3_free_table'; +function SQLite3_Complete (P: PChar): boolean; cdecl; external 'sqlite3.dll' name 'sqlite3_complete'; +function SQLite3_LastInsertRowID(db: TSQLiteDB): int64; cdecl; external 'sqlite3.dll' name 'sqlite3_last_insert_rowid'; +procedure SQLite3_Interrupt (db: TSQLiteDB); cdecl; external 'sqlite3.dll' name 'sqlite3_interrupt'; +procedure SQLite3_BusyHandler (db: TSQLiteDB; CallbackPtr: Pointer; Sender: TObject); cdecl; external 'sqlite3.dll' name'sqlite3_busy_handler' ; +procedure SQLite3_BusyTimeout (db: TSQLiteDB; TimeOut: integer); cdecl; external 'sqlite3.dll' name 'sqlite3_busy_timeout'; +function SQLite3_Changes (db: TSQLiteDB): integer; cdecl; external 'sqlite3.dll' name 'sqlite3_changes'; +function SQLite3_TotalChanges (db: TSQLiteDB): integer; cdecl; external 'sqlite3.dll' name 'sqlite3_total_changes'; +function SQLite3_Prepare (db: TSQLiteDB; SQLStatement: PChar; nBytes: integer; var hStmt: TSqliteStmt; var pzTail: PChar): integer; cdecl; external 'sqlite3.dll' name 'sqlite3_prepare'; +function SQLite3_ColumnCount (hStmt: TSqliteStmt): integer; cdecl; external 'sqlite3.dll' name 'sqlite3_column_count'; +function Sqlite3_ColumnName (hStmt: TSqliteStmt; ColNum: integer): pchar; cdecl; external 'sqlite3.dll' name 'sqlite3_column_name'; +function Sqlite3_ColumnDeclType (hStmt: TSqliteStmt; ColNum: integer): pchar; cdecl; external 'sqlite3.dll' name 'sqlite3_column_decltype'; +function Sqlite3_Step (hStmt: TSqliteStmt): integer; cdecl; external 'sqlite3.dll' name 'sqlite3_step'; +function SQLite3_DataCount (hStmt: TSqliteStmt): integer; cdecl; external 'sqlite3.dll' name 'sqlite3_data_count'; + +function Sqlite3_ColumnBlob (hStmt: TSqliteStmt; ColNum: integer):pointer; cdecl; external 'sqlite3.dll' name 'sqlite3_column_blob'; +function Sqlite3_ColumnBytes (hStmt: TSqliteStmt; ColNum: integer): integer; cdecl; external 'sqlite3.dll' name 'sqlite3_column_bytes'; +function Sqlite3_ColumnDouble (hStmt: TSqliteStmt; ColNum: integer): double; cdecl; external 'sqlite3.dll' name 'sqlite3_column_double'; +function Sqlite3_ColumnInt (hStmt: TSqliteStmt; ColNum: integer): integer; cdecl; external 'sqlite3.dll' name 'sqlite3_column_int'; +function Sqlite3_ColumnText (hStmt: TSqliteStmt; ColNum: integer): pchar; cdecl; external 'sqlite3.dll' name 'sqlite3_column_text'; +function Sqlite3_ColumnType (hStmt: TSqliteStmt; ColNum: integer): integer; cdecl; external 'sqlite3.dll' name 'sqlite3_column_type'; + // function Sqlite3_ColumnInt64 (hStmt: TSqliteStmt; ColNum: integer): SqliteInt64; cdecl; external 'sqlite3.dll' name 'sqlite3_column_int64'; +function SQLite3_Finalize (hStmt: TSqliteStmt): integer; cdecl; external 'sqlite3.dll' name 'sqlite3_finalize'; +function SQLite3_Reset (hStmt: TSqliteStmt): integer; cdecl; external 'sqlite3.dll' name 'sqlite3_reset'; + +// +// In the SQL strings input to sqlite3_prepare() and sqlite3_prepare16(), +// one or more literals can be replace by a wildcard "?" or ":N:" where +// N is an integer. These value of these wildcard literals can be set +// using the routines listed below. +// +// In every case, the first parameter is a pointer to the sqlite3_stmt +// structure returned from sqlite3_prepare(). The second parameter is the +// index of the wildcard. The first "?" has an index of 1. ":N:" wildcards +// use the index N. +// + // The fifth parameter to sqlite3_bind_blob(), sqlite3_bind_text(), and + //sqlite3_bind_text16() is a destructor used to dispose of the BLOB or +//text after SQLite has finished with it. If the fifth argument is the +// special value SQLITE_STATIC, then the library assumes that the information +// is in static, unmanaged space and does not need to be freed. If the +// fifth argument has the value SQLITE_TRANSIENT, then SQLite makes its +// own private copy of the data. +// +// The sqlite3_bind_* routine must be called before sqlite3_step() after +// an sqlite3_prepare() or sqlite3_reset(). Unbound wildcards are interpreted +// as NULL. +// + +function SQLite3_BindBlob(hStmt: TSqliteStmt; ParamNum: integer; +ptrData: pointer; numBytes: integer; ptrDestructor: pointer): integer; +cdecl; external 'sqlite3.dll' name 'sqlite3_bind_blob'; + +implementation + +end. Index: /oup/releases/0.16a/SQLiteTable3.pas =================================================================== --- /oup/releases/0.16a/SQLiteTable3.pas (revision 21) +++ /oup/releases/0.16a/SQLiteTable3.pas (revision 21) @@ -0,0 +1,883 @@ +unit SQLiteTable3; + +{ + Simple classes for using SQLite's exec and get_table. + + TSQLiteDatabase wraps the calls to open and close an SQLite database. + It also wraps SQLite_exec for queries that do not return a result set + + TSQLiteTable wraps sqlite_get_table. + It allows accessing fields by name as well as index and can step through a + result set with the Next procedure. + + Adapted by Tim Anderson (tim@itwriting.com) + Originally created by Pablo Pissanetzky (pablo@myhtpc.net) +} + +interface + +uses + Windows, SQLite3, Classes, Sysutils; + +const + dtStr = 0; + dtInt = 1; + dtBool = 2; + dtNumeric = 3; + dtBlob = 4; + +type + + ESQLiteException = class(Exception) + private + public + end; + + TSQLiteTable = class; + + TSQLiteDatabase = class + private + fDB: TSQLiteDB; + fInTrans: Boolean; + procedure RaiseError(s: string; SQL: string); + + public + constructor Create(const FileName: string); + destructor Destroy; override; + function GetTable(const SQL: string): TSQLiteTable; + procedure ExecSQL(const SQL: string); + procedure UpdateBlob(const SQL: string; BlobData: TStream); + procedure BeginTransaction; + procedure Commit; + procedure Rollback; + function TableExists(TableName: string): boolean; + function GetLastInsertRowID: int64; + + published + property isTransactionOpen: boolean read fInTrans; + + end; + + TSQLiteTable = class + private + fResults: TList; + fRowCount: Cardinal; + fColCount: Cardinal; + fCols: TStringList; + fColTypes: TList; + fRow: Cardinal; + + function GetFields(I: Integer): string; + function GetEOF: Boolean; + function GetBOF: Boolean; + function GetColumns(I: Integer): string; + function GetFieldByName(FieldName: string): string; + function GetFieldIndex(FieldName: string): integer; + function GetCount: Integer; + function GetCountResult: Integer; + + + public + constructor Create(DB: TSQLiteDatabase; const SQL: string); + destructor Destroy; override; + function FieldAsInteger(FieldName: string): integer; + function FieldAsBool(FieldName: string): boolean; + function FieldAsBlob(FieldName: string): TMemoryStream; + function FieldAsBlobText(FieldName: string): string; + function FieldIsNull(FieldName: string): boolean; + function FieldAsString(FieldName: string): string; + function FieldAsDouble(FieldName: string): double; +{ function FieldAsInteger(I: integer): integer; + function FieldAsBool(I: integer): boolean; + function FieldAsBlob(I: Integer): TMemoryStream; + function FieldAsBlobText(I: Integer): string; + function FieldIsNull(I: integer): boolean; + function FieldAsString(I: Integer): string; + function FieldAsDouble(I: Integer): double; +} function Next: Boolean; + function Previous: Boolean; + property EOF: Boolean read GetEOF; + property BOF: Boolean read GetBOF; + property Fields[I: Integer]: string read GetFields; + property FieldByName[FieldName: string]: string read GetFieldByName; + property FieldIndex[FieldName: string]: integer read GetFieldIndex; + property Columns[I: Integer]: string read GetColumns; + property ColCount: Cardinal read fColCount; + property RowCount: Cardinal read fRowCount; + property Row: Cardinal read fRow; + function MoveFirst: boolean; + function MoveLast: boolean; + + + property Count: Integer read GetCount; + + // The property CountResult is used when you execute count(*) queries. + // It returns 0 if the result set is empty or the value of the + // first field as an integer. + property CountResult: Integer read GetCountResult; + end; + + +procedure DisposePointer(ptr: pointer); cdecl; + +implementation + +uses + strutils; + + +procedure DisposePointer(ptr: pointer); cdecl; +begin + + if assigned(ptr) then + begin freemem(ptr) end; + +end; + +//------------------------------------------------------------------------------ +// TSQLiteDatabase +//------------------------------------------------------------------------------ + +constructor TSQLiteDatabase.Create(const FileName: string); +var + Msg: pchar; + iResult: integer; +begin + inherited Create; + + self.fInTrans := false; + + Msg := nil; + try + iResult := SQLite3_Open(PChar(FileName), Fdb); + + if iResult <> SQLITE_OK then + begin + if Assigned(Fdb) then + begin + Msg := Sqlite3_ErrMsg(Fdb); + raise ESqliteException.CreateFmt('Failed to open database "%s" : %s', [FileName, Msg]); + end + else + begin raise ESqliteException.CreateFmt('Failed to open database "%s" : unknown error', [FileName]) end; + end; + + //set a few configs + self.ExecSQL('PRAGMA SYNCHRONOUS=NORMAL;'); + + //this pragma not recommended and may disappear in future + //sqlite versions + //self.ExecSQL('PRAGMA full_column_names = 1;'); + + finally + if Assigned(Msg) then + begin SQLite3_Free(Msg) end; + end; + + +end; + + +//.............................................................................. + +destructor TSQLiteDatabase.Destroy; +begin + + if self.fInTrans then + begin self.ExecSQL('ROLLBACK;') end; //assume rollback + + if Assigned(fDB) then + begin SQLite3_Close(fDB) end; + + inherited; +end; + +function TSQLiteDatabase.GetLastInsertRowID: int64; +begin + result := Sqlite3_LastInsertRowID(self.fDB); +end; + +//.............................................................................. + +procedure TSQLiteDatabase.RaiseError(s: string; SQL: string); +//look up last error and raise and exception with an appropriate message +var + Msg: PChar; +begin + + Msg := nil; + + if sqlite3_errcode(self.fDB) <> SQLITE_OK then + Msg := sqlite3_errmsg(self.fDB); + + if Msg <> nil then + raise ESqliteException.CreateFmt(s + ' "%s" : %s', [SQL, Msg]) + else + raise ESqliteException.CreateFmt(s, [SQL, 'No message']); + +end; + +procedure TSQLiteDatabase.ExecSQL(const SQL: string); +var + Stmt: TSQLiteStmt; + NextSQLStatement: Pchar; + iStepResult: integer; +begin + try + + if Sqlite3_Prepare(self.fDB, PChar(SQL), -1, Stmt, NextSQLStatement) <> SQLITE_OK then + begin RaiseError('Error executing SQL', SQL) end; + + if (Stmt = nil) then + begin RaiseError('Could not prepare SQL statement', SQL) end; + + iStepResult := Sqlite3_step(Stmt); + + if (iStepResult <> SQLITE_DONE) then + begin RaiseError('Error executing SQL statement', SQL) end; + + finally + + if Assigned(Stmt) then + begin Sqlite3_Finalize(stmt) end; + + end; +end; + +procedure TSQLiteDatabase.UpdateBlob(const SQL: string; BlobData: TStream); +var + iSize: integer; + ptr: pointer; + Stmt: TSQLiteStmt; + Msg: Pchar; + NextSQLStatement: Pchar; + iStepResult: integer; + iBindResult: integer; +begin +//expects SQL of the form 'UPDATE MYTABLE SET MYFIELD = ? WHERE MYKEY = 1' + + if pos('?', SQL) = 0 then + begin RaiseError('SQL must include a ? parameter', SQL) end; + + Msg := nil; + try + + if Sqlite3_Prepare(self.fDB, PChar(SQL), -1, Stmt, NextSQLStatement) <> SQLITE_OK then + begin RaiseError('Could not prepare SQL statement', SQL) end; + + if (Stmt = nil) then + begin RaiseError('Could not prepare SQL statement', SQL) end; + +//now bind the blob data + iSize := BlobData.size; + + GetMem(ptr, iSize); + + if (ptr = nil) then + begin raise ESqliteException.CreateFmt('Error getting memory to save blob', [SQL, 'Error']) end; + + BlobData.position := 0; + BlobData.Read(ptr^, iSize); + + iBindResult := SQLite3_BindBlob(stmt, 1, ptr, iSize, @DisposePointer); + + if iBindResult <> SQLITE_OK then + begin RaiseError('Error binding blob to database', SQL) end; + + iStepResult := Sqlite3_step(Stmt); + + if (iStepResult <> SQLITE_DONE) then + begin RaiseError('Error executing SQL statement', SQL) end; + + finally + + if Assigned(Stmt) then + begin Sqlite3_Finalize(stmt) end; + + if Assigned(Msg) then + begin SQLite3_Free(Msg) end; + end; + +end; + +//.............................................................................. + +function TSQLiteDatabase.GetTable(const SQL: string): TSQLiteTable; +begin + Result := TSQLiteTable.Create(Self, SQL); +end; + +procedure TSQLiteDatabase.BeginTransaction; +begin + if not self.fInTrans then + begin + self.ExecSQL('BEGIN TRANSACTION;'); + self.fInTrans := true; + end + else + begin raise ESqliteException.Create('Transaction already open') end; +end; + +procedure TSQLiteDatabase.Commit; +begin + self.ExecSQL('COMMIT;'); + self.fInTrans := false; +end; + +procedure TSQLiteDatabase.Rollback; +begin + self.ExecSQL('ROLLBACK;'); + self.fInTrans := false; +end; + +function TSQLiteDatabase.TableExists(TableName: string): boolean; +var + sql: string; + ds: TSqliteTable; +begin +//returns true if table exists in the database + sql := 'select [sql] from sqlite_master where [type] = ''table'' and lower(name) = ''' + lowercase(TableName) + ''' '; + + try + + ds := self.GetTable(sql); + + result := (ds.Count > 0); + + finally + + freeandnil(ds); + + end; + +end; + + +//------------------------------------------------------------------------------ +// TSQLiteTable +//------------------------------------------------------------------------------ + +constructor TSQLiteTable.Create(DB: TSQLiteDatabase; const SQL: string); +var + Stmt: TSQLiteStmt; + NextSQLStatement: Pchar; + iStepResult: integer; + + ptr: pointer; + iNumBytes: integer; + thisBlobValue: TMemoryStream; + thisStringValue: pstring; + thisBoolValue: pBoolean; + thisDoubleValue: pDouble; + thisIntValue: pInteger; + thisColType: pInteger; + i: integer; + DeclaredColType: Pchar; + ActualColType: integer; + ptrValue: Pchar; + +begin + + try + + self.fRowCount := 0; + self.fColCount := 0; + +//if there are several SQL statements in SQL, NextSQLStatment points to the +//beginning of the next one. Prepare only prepares the first SQL statement. + + if Sqlite3_Prepare(Db.fDB, PChar(SQL), -1, Stmt, NextSQLStatement) <> SQLITE_OK then + begin Db.RaiseError('Error executing SQL', SQL) end; + + if (Stmt = nil) then + begin Db.RaiseError('Could not prepare SQL statement', SQL) end; + + iStepResult := Sqlite3_step(Stmt); + + while (iStepResult <> SQLITE_DONE) do + begin + + case iStepResult of + SQLITE_ROW: + begin + + inc(fRowCount); + + if (fRowCount = 1) then + begin + //get data types + fCols := TStringList.Create; + fCols.CaseSensitive := False; + fColTypes := TList.Create; + + fColCount := SQLite3_ColumnCount(stmt); + + for i := 0 to Pred(fColCount) do + begin + fCols.Add(Sqlite3_ColumnName(stmt, i)); + end; + + for i := 0 to Pred(fColCount) do + begin + + new(thisColType); + DeclaredColType := Sqlite3_ColumnDeclType(stmt, i); + + if DeclaredColType = nil then begin + //use the actual column type instead + //seems to be needed for last_insert_rowid + thisColType^ := Sqlite3_ColumnType(stmt, i); + end else begin + DeclaredColType := strupper(DeclaredColType); + + if DeclaredColType = 'INTEGER' then + begin thisColType^ := dtInt end + else + if DeclaredColType = 'BOOLEAN' then + begin thisColType^ := dtBool end + else + if (DeclaredColType = 'NUMERIC') or (DeclaredColType = 'FLOAT') or (DeclaredColType = 'DOUBLE') then + begin thisColType^ := dtNumeric end + else + if DeclaredColType = 'BLOB' then + begin thisColType^ := dtBlob end + else + begin thisColType^ := dtStr end; + end; + + fColTypes.Add(thiscoltype); + end; + + fResults := TList.Create; + + end; + + //get column values + for i := 0 to Pred(ColCount) do + begin + + ActualColType := Sqlite3_ColumnType(stmt, i); + if (ActualColType = SQLITE_NULL) then + begin fResults.Add(nil) end + else + begin + if pInteger(fColTypes[i])^ = dtInt then + begin + new(thisintvalue); + thisintvalue^ := Sqlite3_ColumnInt(stmt, i); + fResults.Add(thisintvalue); + end + else + if pInteger(fColTypes[i])^ = dtBool then + begin + new(thisboolvalue); + thisboolvalue^ := not (Sqlite3_ColumnInt(stmt, i) = 0); + fResults.Add(thisboolvalue); + end + else + if pInteger(fColTypes[i])^ = dtNumeric then + begin + new(thisdoublevalue); + thisdoublevalue^ := Sqlite3_ColumnDouble(stmt, i); + fResults.Add(thisdoublevalue); + end + else + if pInteger(fColTypes[i])^ = dtBlob then + begin + iNumBytes := Sqlite3_ColumnBytes(stmt, i); + + if iNumBytes = 0 then + begin thisblobvalue := nil end + else + begin + thisblobvalue := TMemoryStream.Create; + thisblobvalue.position := 0; + ptr := Sqlite3_ColumnBlob(stmt, i); + thisblobvalue.writebuffer(ptr^, iNumBytes); + end; + fResults.Add(thisblobvalue); + + end + else + begin + new(thisstringvalue); + ptrValue := Sqlite3_ColumnText(stmt, i); + setstring(thisstringvalue^, ptrvalue, strlen(ptrvalue)); + fResults.Add(thisstringvalue); + end; + end; + + end; + + + + end; + + SQLITE_BUSY: + begin raise ESqliteException.CreateFmt('Could not prepare SQL statement', [SQL, 'SQLite is Busy']) end; + else + begin Db.RaiseError('Could not retrieve data', SQL) end; + end; + + iStepResult := Sqlite3_step(Stmt); + + end; + + fRow := 0; + + finally + if Assigned(Stmt) then + begin Sqlite3_Finalize(stmt) end; + end; + +end; + +//.............................................................................. + +destructor TSQLiteTable.Destroy; +var i: integer; + iColNo: integer; +begin + + + if Assigned(fResults) then + begin for i := 0 to fResults.Count - 1 do + begin + //check for blob type + iColNo := (i mod fColCount); + case pInteger(self.fColTypes[iColNo])^ of + dtBlob: + begin + TMemoryStream(fResults[i]).free; + end; + dtStr: + begin + if fResults[i] <> nil then + begin + setstring(string(fResults[i]^), nil, 0); + dispose(fResults[i]); + end; + end; + else + begin + dispose(fResults[i]) + end; + end; + end; + fResults.Free; + end; + + if Assigned(fCols) then + begin fCols.Free end; + + if Assigned(fColTypes) then + begin for i := 0 to fColTypes.Count - 1 do + begin + dispose(fColTypes[i]); + end end; + fColTypes.Free; + inherited; + end; + +//.............................................................................. + +function TSQLiteTable.GetColumns(I: Integer): string; +begin + Result := fCols[I]; +end; + +//.............................................................................. + +function TSQLiteTable.GetCountResult: Integer; +begin + if not EOF then + begin Result := StrToInt(Fields[0]) end + else + begin Result := 0 end; +end; + +function TSQLiteTable.GetCount: Integer; +begin + Result := FRowCount; +end; + +//.............................................................................. + +function TSQLiteTable.GetEOF: Boolean; +begin + Result := fRow >= fRowCount; +end; + +function TSQLiteTable.GetBOF: Boolean; +begin + Result := fRow <= 0; +end; + +//.............................................................................. + +function TSQLiteTable.GetFieldByName(FieldName: string): string; +begin + Result := GetFields(self.GetFieldIndex(FieldName)); +end; + +function TSQLiteTable.GetFieldIndex(FieldName: string): integer; +begin + + if (fCols = nil) then + begin + raise ESqliteException.Create('Field ' + fieldname + ' Not found. Empty dataset'); + exit; + end; + + if (fCols.count = 0) then + begin + raise ESqliteException.Create('Field ' + fieldname + ' Not found. Empty dataset'); + exit; + end; + + result := fCols.IndexOf(FieldName); + + if (result < 0) then + begin raise ESqliteException.Create('Field not found in dataset: ' + fieldname) end; + +end; + +//.............................................................................. + +function TSQLiteTable.GetFields(I: Integer): string; +var + thisvalue: pstring; + ptr: pointer; + thisboolvalue: pBoolean; + thistype: integer; +begin + Result := ''; + + if EOF then + begin raise ESqliteException.Create('Table is at End of File') end; + +//integer and boolean types are not stored in the resultset +//as strings, so they should be retrieved using the type-specific +//methods + + thistype := pInteger(self.fColTypes[I])^; + + if (thistype = dtInt) or (thistype = dtNumeric) or (thistype = dtBlob) then + begin + ptr := self.fResults[(self.frow * self.fColCount) + I]; + + if ptr <> nil then + begin + raise ESqliteException.Create('Use the specific methods for integer, numeric or blob fields'); + end; + + end + else + if pInteger(self.fColTypes[I])^ = dtBool then + begin + thisboolvalue := self.fResults[(self.frow * self.fColCount) + I]; + if thisboolvalue <> nil then + begin if thisboolvalue^ then + begin result := '1' end + else + begin result := '0' end end; + end + + else + + begin + + thisvalue := self.fResults[(self.frow * self.fColCount) + I]; + if (thisvalue <> nil) then + begin Result := thisvalue^ end + else + begin Result := '' end; //return empty string + end; + +end; + +function TSqliteTable.FieldAsBlob(FieldName: string): TMemoryStream; +var + i: Integer; +begin + + if EOF then + begin raise ESqliteException.Create('Table is at End of File') end; + + i:=Self.FieldIndex[FieldName]; + + if (self.fResults[(self.frow * self.fColCount) + I] = nil) then + begin result := nil end + else + if pInteger(self.fColTypes[I])^ = dtBlob then + begin result := TMemoryStream(self.fResults[(self.frow * self.fColCount) + I]) end + else + begin raise ESqliteException.Create('Not a Blob field') end; +end; + +function TSqliteTable.FieldAsBlobText(FieldName: string): string; +var + MemStream: TMemoryStream; + Buffer: PChar; +begin + result := ''; + + MemStream := self.FieldAsBlob(FieldName); + + if MemStream <> nil then + begin if MemStream.Size > 0 then + begin + MemStream.position := 0; + + Buffer := stralloc(MemStream.Size + 1); + MemStream.readbuffer(Buffer[0], MemStream.Size); + (Buffer + MemStream.Size)^ := chr(0); + SetString(Result, Buffer, MemStream.size); + strdispose(Buffer); + end end; + +end; + + +function TSqliteTable.FieldAsInteger(FieldName: string): integer; +var + i: Integer; +begin + + if EOF then + begin raise ESqliteException.Create('Table is at End of File') end; + + i:=Self.FieldIndex[FieldName]; + + if (self.fResults[(self.frow * self.fColCount) + I] = nil) then + begin result := 0 end + else + if pInteger(self.fColTypes[I])^ = dtInt then + begin result := pInteger(self.fResults[(self.frow * self.fColCount) + I])^ end + else + if pInteger(self.fColTypes[I])^ = dtNumeric then + begin result := trunc(strtofloat(pString(self.fResults[(self.frow * self.fColCount) + I])^)) end + else + begin raise ESqliteException.Create('Not an integer or numeric field') end; + +end; + +function TSqliteTable.FieldAsDouble(FieldName: string): double; +var + i: Integer; +begin + + if EOF then + begin raise ESqliteException.Create('Table is at End of File') end; + + i:=Self.FieldIndex[FieldName]; + + if (self.fResults[(self.frow * self.fColCount) + I] = nil) then + begin result := 0 end + else + if pInteger(self.fColTypes[I])^ = dtInt then + begin result := pInteger(self.fResults[(self.frow * self.fColCount) + I])^ end + else + if pInteger(self.fColTypes[I])^ = dtNumeric then + begin result := pDouble(self.fResults[(self.frow * self.fColCount) + I])^ end + else + begin raise ESqliteException.Create('Not an integer or numeric field') end; + +end; + +function TSqliteTable.FieldAsBool(FieldName: string): boolean; +var + i: Integer; +begin + + if EOF then + begin raise ESqliteException.Create('Table is at End of File') end; + + i:=Self.FieldIndex[FieldName]; + + if (self.fResults[(self.frow * self.fColCount) + I] = nil) then + begin result := false end + else + if pInteger(self.fColTypes[I])^ = dtBool then + begin result := pBoolean(self.fResults[(self.frow * self.fColCount) + I])^ end + else + begin raise ESqliteException.Create('Not a boolean field') end; +end; + +function TSqliteTable.FieldAsString(FieldName: string): string; +var + i: Integer; +begin + + if EOF then + begin raise ESqliteException.Create('Table is at End of File') end; + + i:=Self.FieldIndex[FieldName]; + + if (self.fResults[(self.frow * self.fColCount) + I] = nil) then + begin result := '' end + else + begin result := self.GetFields(I) end; + +end; + +function TSqliteTable.FieldIsNull(FieldName: string): boolean; +var + thisvalue: pointer; + i: Integer; +begin + + if EOF then + begin raise ESqliteException.Create('Table is at End of File') end; + + i:=Self.FieldIndex[FieldName]; + + thisvalue := self.fResults[(self.frow * self.fColCount) + I]; + result := (thisvalue = nil); +end; + +//.............................................................................. + +function TSQLiteTable.Next: boolean; +begin + result := false; + if not EOF then + begin + Inc(fRow); + result := true; + end; +end; + +function TSQLiteTable.Previous: boolean; +begin + result := false; + if not BOF then + begin + Dec(fRow); + result := true; + end; +end; + +function TSQLiteTable.MoveFirst: boolean; +begin + result := false; + if self.fRowCount > 0 then + begin + fRow := 0; + result := true; + end; +end; + +function TSQLiteTable.MoveLast: boolean; +begin + result := false; + if self.fRowCount > 0 then + begin + fRow := fRowCount - 1; + result := true; + end; +end; + + +end. + Index: /oup/releases/0.16a/Unit1_main.dfm =================================================================== --- /oup/releases/0.16a/Unit1_main.dfm (revision 21) +++ /oup/releases/0.16a/Unit1_main.dfm (revision 21) @@ -0,0 +1,297 @@ +object Form1: TForm1 + Left = 0 + Top = 0 + HorzScrollBar.Visible = False + VertScrollBar.Visible = False + AutoScroll = False + Caption = 'Form1' + ClientHeight = 563 + ClientWidth = 692 + Color = clBtnFace + Font.Charset = DEFAULT_CHARSET + Font.Color = clWindowText + Font.Height = -11 + Font.Name = 'Tahoma' + Font.Style = [] + Menu = menu + OldCreateOrder = False + OnClose = FormClose + OnCreate = FormCreate + OnResize = FormResize + PixelsPerInch = 96 + TextHeight = 13 + object panel_all: TPanel + Left = 0 + Top = 100 + Width = 692 + Height = 300 + BevelOuter = bvNone + TabOrder = 0 + object Splitter2: TSplitter + Left = 360 + Top = 0 + Width = 8 + Height = 300 + AutoSnap = False + Beveled = True + MinSize = 360 + end + object panel_left: TPanel + Left = 0 + Top = 0 + Width = 360 + Height = 300 + Cursor = crDrag + Align = alLeft + BevelOuter = bvNone + TabOrder = 0 + object Splitter1: TSplitter + Left = 0 + Top = 241 + Width = 360 + Height = 8 + Cursor = crVSplit + Align = alTop + AutoSnap = False + Beveled = True + MinSize = 75 + OnMoved = Splitter1Moved + end + object panel_files: TPanel + Left = 0 + Top = 0 + Width = 360 + Height = 241 + Align = alTop + BevelOuter = bvNone + TabOrder = 0 + object btn_extractconvert: TButton + Left = 1 + Top = 220 + Width = 358 + Height = 20 + Caption = 'Convert and extract file' + Enabled = False + TabOrder = 0 + WordWrap = True + OnClick = btn_extractconvertClick + end + object list_files: TListBox + Left = 0 + Top = 0 + Width = 360 + Height = 218 + Align = alTop + Font.Charset = DEFAULT_CHARSET + Font.Color = clWindowText + Font.Height = -11 + Font.Name = 'Fixedsys' + Font.Style = [] + ItemHeight = 15 + ParentFont = False + TabOrder = 1 + OnClick = list_filesDblClick + OnDblClick = list_filesDblClick + end + end + object list_extensions: TListBox + Left = 0 + Top = 249 + Width = 360 + Height = 51 + Align = alClient + Font.Charset = DEFAULT_CHARSET + Font.Color = clWindowText + Font.Height = -11 + Font.Name = 'Fixedsys' + Font.Style = [] + ItemHeight = 15 + ParentFont = False + Sorted = True + TabOrder = 1 + OnClick = list_extensionsClick + OnDblClick = list_extensionsClick + end + end + object panel_file: TPanel + Left = 368 + Top = 0 + Width = 324 + Height = 300 + Align = alClient + BevelOuter = bvNone + TabOrder = 1 + object lbl_fileinfo: TLabel + Left = 0 + Top = 0 + Width = 324 + Height = 44 + Align = alTop + AutoSize = False + end + object lbl_zerobyte: TLabel + Left = 32 + Top = 136 + Width = 265 + Height = 41 + AutoSize = False + Caption = + 'Zero byte file. Oni will take the data for this file of level0_f' + + 'inal.dat/raw' + Font.Charset = DEFAULT_CHARSET + Font.Color = clWindowText + Font.Height = -16 + Font.Name = 'Tahoma' + Font.Style = [] + ParentFont = False + Visible = False + WordWrap = True + end + object hex: TMPHexEditor + Left = 0 + Top = 44 + Width = 324 + Height = 256 + Cursor = crIBeam + Align = alClient + Font.Charset = DEFAULT_CHARSET + Font.Color = clWindowText + Font.Height = -16 + Font.Name = 'Fixedsys' + Font.Style = [] + ParentFont = False + TabOrder = 0 + BytesPerRow = 16 + Translation = tkAsIs + OffsetFormat = '6!10:0x|' + Colors.Background = clWindow + Colors.ChangedBackground = clWhite + Colors.ChangedText = clRed + Colors.CursorFrame = clNavy + Colors.Offset = clBlack + Colors.OddColumn = clBlue + Colors.EvenColumn = clNavy + Colors.CurrentOffsetBackground = clBtnShadow + Colors.OffsetBackGround = clBtnFace + Colors.CurrentOffset = clBtnHighlight + Colors.Grid = clBtnFace + Colors.NonFocusCursorFrame = clAqua + Colors.ActiveFieldBackground = clWindow + FocusFrame = False + AllowInsertMode = False + DrawGridLines = False + ReadOnlyView = True + Version = 'May 23, 2005; '#169' markus stephany, vcl[at]mirkes[dot]de' + end + end + end + object group_progress: TGroupBox + Left = 296 + Top = 480 + Width = 297 + Height = 57 + Caption = 'Extracting...' + TabOrder = 1 + Visible = False + object lbl_progress: TLabel + Left = 10 + Top = 36 + Width = 279 + Height = 18 + AutoSize = False + end + object progress: TProgressBar + Left = 8 + Top = 16 + Width = 217 + Height = 17 + Step = 1 + TabOrder = 0 + end + object btn_extractcancel: TButton + Left = 232 + Top = 16 + Width = 57 + Height = 33 + Caption = 'Cancel' + TabOrder = 1 + OnClick = btn_extractcancelClick + end + end + object statbar: TStatusBar + Left = 0 + Top = 546 + Width = 692 + Height = 17 + BiDiMode = bdLeftToRight + Panels = < + item + Text = 'Current .dat: -' + Width = 500 + end + item + Text = 'Files: -' + Width = 90 + end + item + Text = 'Extensions: -' + Width = 100 + end> + ParentBiDiMode = False + end + object fopen: TOpenDialog + Filter = 'Oni-Dat-Files|*.dat|Oni-Sep-Files (MAC)|*.sep' + Left = 64 + Top = 120 + end + object menu: TMainMenu + AutoHotkeys = maManual + Left = 224 + object menu_main: TMenuItem + Caption = '&Main' + object menu_loaddat: TMenuItem + Caption = '&Select .dat-file ...' + OnClick = menu_loaddatClick + end + object menu_sep1: TMenuItem + Caption = '-' + end + object menu_exit: TMenuItem + Caption = '&Exit' + OnClick = menu_exitClick + end + end + object menu_extract: TMenuItem + Caption = '&Extract/Convert' + Enabled = False + object menu_extractfile: TMenuItem + Caption = 'Convert and extract current &file' + OnClick = menu_extractfileClick + end + object menu_extractlist: TMenuItem + Caption = 'Convert and extract all files currently in &list' + OnClick = menu_extractlistClick + end + object menu_extractall: TMenuItem + Caption = 'Convert and extract &all files' + OnClick = menu_extractallClick + end + end + object menu_tools: TMenuItem + Caption = '&Tools' + Enabled = False + object menu_preview: TMenuItem + Caption = '&Preview Window ...' + OnClick = menu_previewClick + end + object menu_binedit: TMenuItem + Caption = '&Binary .dat editor ...' + OnClick = menu_bineditClick + end + object menu_txmpreplace: TMenuItem + Caption = '&TXMP replacer ...' + OnClick = menu_txmpreplaceClick + end + end + end +end Index: /oup/releases/0.16a/Unit1_main.pas =================================================================== --- /oup/releases/0.16a/Unit1_main.pas (revision 21) +++ /oup/releases/0.16a/Unit1_main.pas (revision 21) @@ -0,0 +1,439 @@ +UNIT Unit1_main; +INTERFACE +USES + Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, + Dialogs, StdCtrls, StrUtils, Clipbrd, ExtCtrls, ComCtrls, Menus, + Unit2_functions, Unit3_data, Unit5_preview, Unit7_txmpreplace, Unit8_binedit, + Grids, MPHexEditor; + +TYPE + TForm1 = Class(TForm) + panel_all: TPanel; + panel_left: TPanel; + Splitter1: TSplitter; + panel_files: TPanel; + btn_extractconvert: TButton; + list_files: TListBox; + list_extensions: TListBox; + Splitter2: TSplitter; + fopen: TOpenDialog; + group_progress: TGroupBox; + progress: TProgressBar; + lbl_progress: TLabel; + menu: TMainMenu; + menu_main: TMenuItem; + menu_exit: TMenuItem; + menu_preview: TMenuItem; + btn_extractcancel: TButton; + menu_tools: TMenuItem; + menu_txmpreplace: TMenuItem; + menu_extract: TMenuItem; + menu_extractfile: TMenuItem; + menu_extractlist: TMenuItem; + menu_extractall: TMenuItem; + menu_loaddat: TMenuItem; + menu_sep1: TMenuItem; + menu_binedit: TMenuItem; + statbar: TStatusBar; + panel_file: TPanel; + lbl_fileinfo: TLabel; + hex: TMPHexEditor; + lbl_zerobyte: TLabel; + PROCEDURE menu_extractallClick(Sender: TObject); + PROCEDURE menu_extractlistClick(Sender: TObject); + PROCEDURE menu_extractfileClick(Sender: TObject); + PROCEDURE menu_bineditClick(Sender: TObject); + PROCEDURE menu_loaddatClick(Sender: TObject); + PROCEDURE menu_txmpreplaceClick(Sender: TObject); + PROCEDURE menu_exitClick(Sender: TObject); + PROCEDURE btn_extractcancelClick(Sender: TObject); + PROCEDURE menu_previewClick(Sender: TObject); + PROCEDURE Splitter1Moved(Sender: TObject); + PROCEDURE FormClose(Sender: TObject; var Action: TCloseAction); + PROCEDURE btn_hexcopyClick(Sender: TObject); + PROCEDURE list_extensionsClick(Sender: TObject); + PROCEDURE FormResize(Sender: TObject); + PROCEDURE btn_extractconvertClick(Sender: TObject); + PROCEDURE FormCreate(Sender: TObject); + PROCEDURE list_filesDblClick(Sender: TObject); + PROCEDURE btn_loadClick(Sender: TObject); + PRIVATE + PUBLIC + END; + +VAR + Form1: TForm1; + +IMPLEMENTATION +{$R *.dfm} + +PROCEDURE DoAfterLoadOfADat; + VAR + i:LongWord; + txt:Text; + temp4:LongWord; + temp2:Word; + temp1:Byte; + BEGIN + IF NOT DirectoryExists(GetExtractPath) THEN + CreateDir(GetExtractPath); + AssignFile(txt,GetExtractPath+'\___TXMP-FILES___.TXT'); + ReWrite(txt); + FOR i:=0 TO dat_header.Extensions-1 DO BEGIN + IF (dat_extensionsmap[i].Extension[3]='T') AND + (dat_extensionsmap[i].Extension[2]='X') AND + (dat_extensionsmap[i].Extension[1]='M') AND + (dat_extensionsmap[i].Extension[0]='P') THEN BEGIN + WriteLn(txt, FormatNumber(dat_extensionsmap[i].ExtCount,4,'0')+' TXMP-Files'); + Break; + END; + END; + WriteLn(txt,'FileName'+#9+'MipMap'+#9+'Depth'+#9+'ImgX'+#9+'ImgY'+#9+'StoreT'); + FOR i:=0 TO dat_header.Files-1 DO BEGIN + IF dat_files[i].Extension='TXMP' THEN BEGIN + Write(txt,dat_files[i].FileName+#9); + LoadDatFilePart(i,$88,1,@temp1); + Write(txt,IntToHex(temp1,2)+#9); + LoadDatFilePart(i,$89,1,@temp1); + Write(txt,IntToHex(temp1,2)+#9); + LoadDatFilePart(i,$8C,2,@temp2); + Write(txt,IntToHex(temp2,4)+#9); + LoadDatFilePart(i,$8E,2,@temp2); + Write(txt,IntToHex(temp2,4)+#9); + LoadDatFilePart(i,$90,1,@temp1); + Write(txt,IntToHex(temp1,2)+#9); + WriteLn(txt,''); + END; + END; + CloseFile(txt); + + IF NOT DirectoryExists(GetExtractPath) THEN + CreateDir(GetExtractPath); + AssignFile(txt,GetExtractPath+'\___TXAN-FILES___.TXT'); + ReWrite(txt); + FOR i:=0 TO dat_header.Extensions-1 DO BEGIN + IF (dat_extensionsmap[i].Extension[3]='T') AND + (dat_extensionsmap[i].Extension[2]='X') AND + (dat_extensionsmap[i].Extension[1]='A') AND + (dat_extensionsmap[i].Extension[0]='N') THEN BEGIN + WriteLn(txt, FormatNumber(dat_extensionsmap[i].ExtCount,4,'0')+' TXAN-Files'); + Break; + END; + END; + WriteLn(txt,'FileName'+#9+'Loopspeed'+#9+'Unknown'+#9+'Links'); + FOR i:=0 TO dat_header.Files-1 DO BEGIN + IF dat_files[i].Extension='TXAN' THEN BEGIN + Write(txt,dat_files[i].FileName+#9); + LoadDatFilePart(i,$14,2,@temp2); + Write(txt,IntToHex(temp2,4)+#9); + LoadDatFilePart(i,$16,2,@temp2); + Write(txt,IntToHex(temp2,4)+#9); + LoadDatFilePart(i,$1C,4,@temp4); + Write(txt,IntToHex(temp4,8)+#9); + WriteLn(txt,''); + END; + END; + CloseFile(txt); + END; + +PROCEDURE LoadDat; + VAR i:LongWord; + BEGIN + Form1.fopen.InitialDir:=AppSettings.DatPath; + IF Form1.fopen.Execute THEN BEGIN + Form1.Caption:='Oni Un/Packer '+version+' ('+ExtractFileName(Form1.fopen.FileName)+')'; + AppSettings.DatPath:=ExtractFilepath(Form1.fopen.FileName); + Form1.list_files.Items.Clear; + Form1.list_extensions.Items.Clear; + IF LoadDatInfos(Form1.fopen.FileName) THEN BEGIN + Form1.list_extensions.Items.Add('_All files: '+FormatNumber(dat_header.Files,4,' ')); + FOR i:=0 TO dat_header.Extensions-1 DO BEGIN + WITH dat_extensionsmap[i] DO BEGIN + Form1.list_extensions.Items.Add( + Extension[3]+Extension[2]+Extension[1]+Extension[0]+': '+ + FormatNumber(ExtCount,4,' '));{+' (Ident: 0x'+ + IntToHex(Ident[7],2)+IntToHex(Ident[6],2)+IntToHex(Ident[5],2)+IntToHex(Ident[4],2)+IntToHex(Ident[3],2)+IntToHex(Ident[2],2)+IntToHex(Ident[1],2)+IntToHex(Ident[0],2)+')');} + END; + END; + Form1.list_extensions.ItemIndex:=0; + Form1.list_extensionsClick(Form1); + Form1.list_files.ItemIndex:=0; + Form1.list_filesDblClick(Form1); + Form1.statbar.Panels.Items[0].Text:='Current .dat: '+dat_FileName; + Form1.statbar.Panels.Items[1].Text:='Files: '+IntToStr(dat_header.Files); + Form1.statbar.Panels.Items[2].Text:='Extensions: '+IntToStr(dat_header.Extensions); + Form1.menu_tools.Enabled:=True; + Form1.menu_extract.Enabled:=True; + Form1.btn_extractconvert.Enabled:=True; + + Form7.RecreateTXMPlist; + Form8.Recreatelist; + + DoAfterLoadOfADat; + + END ELSE BEGIN + ShowMessage('Error while loading the file:'+CrLf+Form1.fopen.FileName+CrLf+'Perhaps not an Oni-.dat-file?'); + END; + END; + END; + +PROCEDURE TForm1.btn_loadClick(Sender: TObject); + BEGIN + LoadDat; + END; + +PROCEDURE TForm1.list_filesDblClick(Sender: TObject); + VAR + id:LongWord; + temp:Tdata; + mem:TMemoryStream; + BEGIN + id:=StrToInt(MidStr(list_files.Items.Strings[list_files.ItemIndex],1,5)); + IF (dat_files[id].FileType AND $02)=0 THEN BEGIN + lbl_fileinfo.Caption:= + 'Filename: '+dat_files[id].FileName+CrLf+ + 'Size: '+FormatFileSize(dat_files[id].Size)+' ('+IntToStr(dat_files[id].Size)+' Bytes)'+CrLf+ + 'Address in .dat: 0x'+IntTohex(dat_files[id].DatAddr,8); + temp:=LoadDatFile(id); + mem:=TMemoryStream.Create; + mem.Write(temp[0],Length(temp)); + hex.LoadFromStream(mem); + mem.Free; + Form5.ShowPreview(id); + lbl_zerobyte.Visible:=False; + hex.Visible:=True; + END ELSE BEGIN + lbl_fileinfo.Caption:= + 'Filename: '+dat_files[id].FileName; + lbl_zerobyte.Visible:=True; + hex.Visible:=False; + END; + END; + +PROCEDURE TForm1.FormCreate(Sender: TObject); + BEGIN + Form1.Caption:='Oni Un/Packer '+version; + Form1.FormResize(Form1); + + panel_all.Align:=alClient; + + IF FileExists(ExtractFilepath(Application.EXEname)+'\oniunpacker.ini') THEN BEGIN + AssignFile(AppSettingsFile,ExtractFilepath(Application.EXEname)+'\oniunpacker.ini'); + Reset(AppSettingsFile); + Read(AppSettingsFile,AppSettings); + CloseFile(AppSettingsFile); + END ELSE BEGIN + AppSettings.DatPath:='D:\Spiele\Oni\GameDataFolder'; + AppSettings.ExtractPath:='C:\Dokumente und Einstellungen\Administrator\Desktop'; + END; + END; + +PROCEDURE TForm1.btn_extractconvertClick(Sender: TObject); + BEGIN + Form1.menu_extractfileClick(Form1); + END; + +PROCEDURE TForm1.FormResize(Sender: TObject); + CONST + MinWidth:Integer=750; + MinHeight:Integer=500; + BEGIN + IF NOT group_progress.Visible THEN BEGIN + IF Form1.Width0 THEN Inc(errors); + IF (i MOD 25)=0 THEN BEGIN + lbl_progress.Caption:=IntToStr(i)+'/'+IntToStr(progress.Max); + progress.Position:=i; + Application.ProcessMessages; + IF btn_extractcancel.Caption='Cancel_' THEN BEGIN + btn_extractcancel.Caption:='Cancel'; + Break; + END; + END; + END; + IF errors>0 THEN + ShowMessage(IntToStr(errors)+' errors encountered.'); + + group_progress.Visible:=False; + Form1.Width:=oldwidth; + Form1.Height:=oldheight; + Form1.WindowState:=oldstate; + //FOR i:=0 TO menu.ComponentCount DO menu.Items.Items[i].Enabled:=True; + panel_all.Visible:=True; + END; + +PROCEDURE TForm1.menu_extractallClick(Sender: TObject); + VAR + i:LongWord; + errors:LongWord; + oldwidth,oldheight:Integer; + oldstate:TWindowState; + BEGIN + panel_all.Visible:=False; + group_progress.Visible:=True; + //FOR i:=0 TO menu.ComponentCount DO menu.Items.Items[i].Enabled:=False; + oldwidth:=Form1.Width; + oldheight:=Form1.Height; + oldstate:=Form1.WindowState; + Form1.WindowState:=wsNormal; + Form1.Width:=400; + Form1.Height:=120; + group_progress.Left:=0; + group_progress.Top:=0; + group_progress.Width:=Form1.Width-8; + progress.Width:=group_progress.Width-80; + progress.Max:=dat_header.files; + btn_extractcancel.Left:=group_progress.Width-65; + btn_extractcancel.Caption:='Cancel'; + btn_extractcancel.SetFocus; + + errors:=0; + FOR i:=0 TO High(dat_files) DO BEGIN + IF ExportFile(i,True)>0 THEN Inc(errors); + IF (i MOD 25)=0 THEN BEGIN + lbl_progress.Caption:=IntToStr(i)+'/'+IntToStr(dat_header.Files); + progress.Position:=i; + Application.ProcessMessages; + IF btn_extractcancel.Caption='Cancel_' THEN BEGIN + btn_extractcancel.Caption:='Cancel'; + Break; + END; + END; + END; + IF errors>0 THEN + ShowMessage(IntToStr(errors)+' errors encountered.'); + + group_progress.Visible:=False; + Form1.Width:=oldwidth; + Form1.Height:=oldheight; + Form1.WindowState:=oldstate; + //FOR i:=0 TO menu.ComponentCount DO menu.Items.Items[i].Enabled:=True; + panel_all.Visible:=True; + END; + +END. Index: /oup/releases/0.16a/Unit2_functions.pas =================================================================== --- /oup/releases/0.16a/Unit2_functions.pas (revision 21) +++ /oup/releases/0.16a/Unit2_functions.pas (revision 21) @@ -0,0 +1,216 @@ +UNIT Unit2_functions; +INTERFACE +USES Classes, SysUtils, StrUtils, Math, SQLiteTable3, Unit3_data, Unit4_Exporters; + +FUNCTION LoadDatInfos(filename:String):Boolean; +FUNCTION LoadDatFile(fileid:LongWord):Tdata; +PROCEDURE SaveDatFile(fileid:LongWord; data:Tdata); +FUNCTION LoadDatFilePart(fileid,offset,size:LongWord; target:Pointer):Boolean; +FUNCTION LoadRawFilePart(address,size:LongWord; target:Pointer):Boolean; +FUNCTION FormatNumber(value:LongWord; width:Byte; leadingzeros:Char):String; +FUNCTION FormatFileSize(size:LongWord):String; +FUNCTION CreateHexString(data:Tdata; HexOnly:Boolean):String; +FUNCTION ExportFile(fileid:LongWord; convert:Boolean):Integer; +FUNCTION GetWinFileName(fileid:LongWord; substring:String):String; +FUNCTION GetExtractPath:String; + + + +IMPLEMENTATION + + +FUNCTION LoadDatInfos(filename:String):Boolean; + VAR i:LongWord; + dat_file:TFileStream; + BEGIN + Result:=True; + dat_filename:=filename; + raw_filename:=MidStr(filename,1,Length(filename)-3)+'raw'; + dat_file:=TFileStream.Create(filename, fmOpenRead); + dat_file.Read(dat_header,SizeOf(dat_header)); + FOR i:=0 TO High(dat_header.Ident) DO + IF dat_header.Ident[i]<>header_ident1[i] THEN BEGIN + Result:=False; + Exit; + END; +{ FOR i:=0 TO High(dat_header.Ident2) DO + IF dat_header.Ident2[i]<>header_ident2[i] THEN BEGIN + Result:=False; + Exit; + END; +} + SetLength(dat_filesmap,dat_header.Files); + SetLength(dat_files,dat_header.Files); + FOR i:=0 TO dat_header.Files-1 DO dat_file.Read(dat_filesmap[i],SizeOf(dat_filesmap[i])); + FOR i:=0 TO dat_header.Files-1 DO BEGIN + dat_files[i].Extension:=dat_filesmap[i].Extension; + dat_files[i].Extension:=ReverseString(dat_files[i].Extension); + dat_files[i].Size:=dat_filesmap[i].FileSize; + dat_files[i].FileType:=dat_filesmap[i].FileType; + dat_files[i].DatAddr:=dat_filesmap[i].DataAddr-8+dat_header.DataAddr; + IF (dat_filesmap[i].FileType AND $01)=0 THEN BEGIN + dat_file.Seek(dat_filesmap[i].NameAddr+dat_header.NamesAddr,soFromBeginning); + SetLength(dat_files[i].Name,100); + dat_file.Read(dat_files[i].Name[1],100); + dat_files[i].Name:=MidStr(dat_files[i].Name,1+4,Pos(#0,dat_files[i].Name)-1-4); + END ELSE BEGIN + dat_files[i].Name:=''; + END; + dat_files[i].FileName:=FormatNumber(i,5,'0')+'-'+dat_files[i].Name+'.'+dat_files[i].Extension; + END; + dat_file.Seek($40+dat_header.Files*$14,soFromBeginning); + SetLength(dat_namedfilesmap,dat_header.NamedFiles); + FOR i:=0 TO dat_header.NamedFiles-1 DO dat_file.Read(dat_namedfilesmap[i],SizeOf(dat_namedfilesmap[i])); + + dat_file.Seek($40+dat_header.Files*$14+dat_header.NamedFiles*$8,soFromBeginning); + SetLength(dat_extensionsmap,dat_header.Extensions); + FOR i:=0 TO dat_header.Extensions-1 DO dat_file.Read(dat_extensionsmap[i],SizeOf(dat_extensionsmap[i])); + + dat_file.Free; + END; + + +FUNCTION LoadDatFile(fileid:LongWord):Tdata; + VAR dat_file:TFileStream; + BEGIN + dat_file:=TFileStream.Create(dat_filename, fmOpenRead); + dat_file.Seek(dat_files[fileid].DatAddr,soFromBeginning); + SetLength(Result,dat_files[fileid].Size); + dat_file.Read(Result[0],dat_files[fileid].Size); + dat_file.Free; + END; + + +PROCEDURE SaveDatFile(fileid:LongWord; data:Tdata); + VAR dat_file:TFileStream; + BEGIN + dat_file:=TFileStream.Create(dat_filename, fmOpenReadWrite); + dat_file.Seek(dat_files[fileid].DatAddr,soFromBeginning); + dat_file.Write(data[0],Length(data)); + dat_file.Free; + END; + + +FUNCTION LoadDatFilePart(fileid,offset,size:LongWord; target:Pointer):Boolean; + VAR dat_file:TFileStream; + BEGIN + dat_file:=TFileStream.Create(dat_filename, fmOpenRead); + Result:=True; + dat_file.Seek(dat_files[fileid].DatAddr+offset,soFromBeginning); + dat_file.Read(target^,size); + dat_file.Free; + END; + + +FUNCTION LoadRawFilePart(address,size:LongWord; target:Pointer):Boolean; + VAR + filestream:TFileStream; + BEGIN + Result:=True; + filestream:=TFileStream.Create(AnsiReplaceStr(dat_filename,'.dat','.raw'),fmOpenRead); + filestream.Seek(address,soFromBeginning); + filestream.Read(target^,size); + filestream.Free; + END; + + +FUNCTION FormatNumber(value:LongWord; width:Byte; leadingzeros:Char):String; + BEGIN + Result:=AnsiReplaceStr(Format('%'+IntToStr(width)+'u',[value]),' ',leadingzeros); + END; + + +FUNCTION FormatFileSize(size:LongWord):String; + BEGIN + IF size>=1024*1024*1024 THEN BEGIN + Result:=FloatToStrF(size/1024/1024/1024,ffFixed,5,1)+' GB'; + END ELSE BEGIN + IF size>=1024*1024 THEN BEGIN + Result:=FloatToStrF(size/1024/1024,ffFixed,5,1)+' MB'; + END ELSE BEGIN + IF size>=1024 THEN BEGIN + Result:=FloatToStrF(size/1024,ffFixed,5,1)+' KB'; + END ELSE BEGIN + Result:=IntToStr(size)+' B'; + END; + END; + END; + END; + + +FUNCTION CreateHexString(data:Tdata; HexOnly:Boolean):String; + VAR + string_build,ascii_version:String; + i:LongWord; + BEGIN + string_build:=''; + ascii_version:=''; + FOR i:=0 TO High(data) DO BEGIN + IF NOT HexOnly THEN + IF (i MOD 16)=0 THEN + string_build:=string_build+'0x'+IntToHex(i,6)+' '; + string_build:=string_build+IntToHex(data[i],2); + IF NOT HexOnly THEN BEGIN + IF data[i]>=32 THEN ascii_version:=ascii_version+Chr(data[i]) + ELSE ascii_version:=ascii_version+'.'; + IF ((i+1) MOD 2)=0 THEN string_build:=string_build+#32; + IF ((i+1) MOD 16)=0 THEN BEGIN + string_build:=string_build+#32+ascii_version+CrLf; + ascii_version:=''; + END; + END; + END; + Result:=string_build; + END; + + +FUNCTION ExportFile(fileid:LongWord; convert:Boolean):Integer; + VAR + i:Byte; + BEGIN + Result:=export_noerror; + + //ExportDefFileHeader(fileid); + + IF (dat_files[fileid].FileType AND $02)=0 THEN BEGIN + //ExportDatFile(fileid); + + FOR i:=1 TO Length(ExportHandlers)+1 DO BEGIN + IF i<=Length(ExportHandlers) THEN BEGIN + IF ExportHandlers[i].Ext=dat_files[fileid].Extension THEN BEGIN + IF ExportHandlers[i].needed THEN BEGIN + CASE ExportHandlers[i].Handler(fileid,convert) OF + 0: Result:=0; + ELSE + Result:=export_handlererror; + END; + END; + Break; + END; + END ELSE BEGIN + Result:=export_nohandler; + END; + END; + END; + END; + + +FUNCTION GetWinFileName(fileid:LongWord; substring:String):String; + VAR + name:String; + BEGIN + name:=dat_files[fileid].Name; + name:=AnsiReplaceStr(name,'\','__'); + name:=AnsiReplaceStr(name,'/','__'); + name:=AnsiReplaceStr(name,'>','__'); + name:=AnsiReplaceStr(name,'<','__'); + Result:=FormatNumber(fileid,5,'0')+'-'+name+'.'+substring+'.'+dat_files[fileid].Extension; + END; + +FUNCTION GetExtractPath:String; + BEGIN + Result:=ExtractFilePath(dat_filename)+'\extracted_'+ExtractFileName(dat_filename); + END; + + +END. Index: /oup/releases/0.16a/Unit3_data.pas =================================================================== --- /oup/releases/0.16a/Unit3_data.pas (revision 21) +++ /oup/releases/0.16a/Unit3_data.pas (revision 21) @@ -0,0 +1,84 @@ +UNIT Unit3_data; +INTERFACE +USES Classes; + +CONST + version:String='v0.16a'; + CrLf:String[2]=#13+#10; + +TYPE + Tdata=Array OF Byte; + Theader=PACKED RECORD + Ident:Array[0..$13] OF Byte; + Files:LongWord; + NamedFiles:LongWord; + Extensions:LongWord; + DataAddr:LongWord; + DataSize:LongWord; + NamesAddr:LongWord; + NamesSize:LongWord; + Ident2:Array[0..$F] OF Byte; + END; + Tfilesmap=Array OF PACKED RECORD + Extension:Array[0..$3] OF Char; + DataAddr:LongWord; + NameAddr:LongWord; + FileSize:LongWord; + FileType:LongWord; + END; + Tfiles=Array OF PACKED RECORD + FileName:String; + Extension:String[4]; + Name:String; + Size:LongWord; + FileType:LongWord; + DatAddr:LongWord; + END; + + Tnamedfilesmap=Array OF PACKED RECORD + FileNumber:LongWord; + blubb:LongWord; + END; + Textensionsmap=Array OF PACKED RECORD + Ident:Array[0..$7] OF Byte; + Extension:Array[0..$3] OF Char; + ExtCount:LongWord; + END; + + TAppSettings=RECORD + DatPath:String[250]; + ExtractPath:String[250]; + END; + + TExportHandlers=RECORD + Ext:String[4]; + needed:Boolean; + Handler:Function(fileid:LongWord; convert:Boolean):Integer; + END; + +VAR + dat_filename:String=''; + raw_filename:String=''; + dat_header:Theader; + dat_filesmap:Tfilesmap; + dat_files:Tfiles; + dat_namedfilesmap:Tnamedfilesmap; + dat_extensionsmap:Textensionsmap; + AppSettings:TAppSettings; + AppSettingsFile:File OF TAppSettings; + +CONST + header_ident1:Array[0..$13] OF Byte= + ($1F,$27,$DC,$33,$DF,$BC,$03,$00,$31,$33,$52,$56,$40,$00,$14,$00,$10,$00,$08,$00); + header_ident2:Array[0..$F] OF Byte= + ($99,$CF,$40,$00,$90,$4F,$63,$00,$F4,$55,$5F,$00,$90,$4F,$63,$00); + + export_noerror:Integer=0; + export_nohandler:Integer=1; + export_handlererror:Integer=2; + export_error:Integer=3; + +IMPLEMENTATION + +END. + Index: /oup/releases/0.16a/Unit4_Exporters.pas =================================================================== --- /oup/releases/0.16a/Unit4_Exporters.pas (revision 21) +++ /oup/releases/0.16a/Unit4_Exporters.pas (revision 21) @@ -0,0 +1,181 @@ +UNIT Unit4_Exporters; +INTERFACE +USES Classes, StrUtils, SysUtils, Math, Unit3_data, Unit6_imgfuncs; + +PROCEDURE ExportDefLine(fileid:LongWord; line:String; create:Boolean); +PROCEDURE ExportDefFileHeader(fileid:LongWord); +PROCEDURE ExportDatFile(fileid:LongWord); + +FUNCTION ExportTRAC(fileid:LongWord; convert:Boolean):Integer; +FUNCTION ExportTXAN(fileid:LongWord; convert:Boolean):Integer; +FUNCTION ExportTXMB(fileid:LongWord; convert:Boolean):Integer; +FUNCTION ExportTXMP(fileid:LongWord; convert:Boolean):Integer; +VAR + ExportHandlers:Array[1..5] OF TExportHandlers=( + (Ext:'ABNA'; needed:False), + //(Ext:'AGDB'; needed:False), + (Ext:'TRAC'; needed:True; Handler:ExportTRAC), + (Ext:'TXAN'; needed:True; Handler:ExportTXAN), + (Ext:'TXMB'; needed:True; Handler:ExportTXMB), + (Ext:'TXMP'; needed:True; Handler:ExportTXMP) + ); + + + +IMPLEMENTATION +USES Unit2_functions; + +PROCEDURE ExportDefLine(fileid:LongWord; line:String; create:Boolean); + VAR + filestream:TFileStream; + data:Tdata; + i:LongWord; + BEGIN + SetLength(data,Length(line)+2); + FOR i:=1 TO Length(line) DO + data[i-1]:=Ord(line[i]); + data[Length(line)]:=13; + data[Length(line)+1]:=10; + { + IF create THEN + filestream:=TFileStream.Create(GetExtractPath+'\'+GetWinFileName(fileid,'_DEF_'),fmCreate) + ELSE BEGIN + filestream:=TFileStream.Create(GetExtractPath+'\'+GetWinFileName(fileid,'_DEF_'),fmOpenWrite); + filestream.Seek(0,soFromEnd); + END; + filestream.Write(data[0],Length(data)); + filestream.Free; + } + END; + +PROCEDURE ExportDefFileHeader(fileid:LongWord); + BEGIN + IF NOT DirectoryExists(GetExtractPath) THEN + CreateDir(GetExtractPath); + WITH dat_files[fileid] DO + ExportDefLine(fileid,FormatNumber(fileid,5,'0')+':'+Name+':'+Extension+':'+IntToHex(Size,8)+':'+IntToHex(FileType,8),True); + END; + +PROCEDURE ExportDatFile(fileid:LongWord); + VAR + filestream:TFileStream; + data:Tdata; + BEGIN + data:=LoadDatFile(fileid); + filestream:=TFileStream.Create(GetExtractPath+'\'+GetWinFileName(fileid,'_DAT_'),fmCreate); + filestream.Write(data[0],Length(data)); + filestream.Free; + END; + + +FUNCTION ExportTRAC; + VAR + link:LongWord; + linkcount:Word; + i:LongWord; + BEGIN + Result:=export_noerror; + + LoadDatFilePart(fileid,$18,SizeOf(link),@link); + link:=link DIV 256; + ExportDefLine(fileid,FormatNumber(0,4,'0')+':LINKtoTRAC:'+FormatNumber(link,5,'0')+':'+dat_files[link].Name+':'+dat_files[link].Extension,False); + + LoadDatFilePart(fileid,$1E,SizeOf(linkcount),@linkcount); + ExportDefLine(fileid,'TRAMLINKS:'+FormatNumber(linkcount,4,'0'),False); + FOR i:=1 TO linkcount DO BEGIN + LoadDatFilePart(fileid,$20+(i-1)*12+8,SizeOf(link),@link); + link:=link DIV 256; + ExportDefLine(fileid,FormatNumber(i,4,'0')+':LINKtoTRAM:'+FormatNumber(link,5,'0')+':'+dat_files[link].Name+':'+dat_files[link].Extension,False); + END; + END; + +FUNCTION ExportTXAN; + VAR + loop_speed,unknown:Word; + linkcount:LongWord; + link:LongWord; + i:Byte; + BEGIN + Result:=export_noerror; + + LoadDatFilePart(fileid,$14,SizeOf(loop_speed),@loop_speed); + LoadDatFilePart(fileid,$16,SizeOf(unknown),@unknown); + ExportDefLine(fileid,'LOOPSPEED:'+FormatNumber(loop_speed,2,'0'),False); + ExportDefLine(fileid,'UNKNOWN:'+FormatNumber(unknown,2,'0'),False); + + LoadDatFilePart(fileid,$1C,SizeOf(linkcount),@linkcount); + ExportDefLine(fileid,'TXMPLINKS:'+FormatNumber(linkcount,4,'0'),False); + FOR i:=0 TO linkcount-1 DO BEGIN + LoadDatFilePart(fileid,$20+i*4,SizeOf(link),@link); + link:=link DIV 256; + IF link=0 THEN link:=fileid-1; + ExportDefLine(fileid,FormatNumber(i,4,'0')+':LINKtoTXMP:'+FormatNumber(link,5,'0')+':'+dat_files[link].Name+':'+dat_files[link].Extension,False); + END; + END; + +FUNCTION ExportTXMB; + VAR + filestream:TFileStream; + subfile:Byte; + linkcount:LongWord; + link:LongWord; + width,height:Word; + cols,rows:Word; + i:Byte; + img:TImgPackage; + data:Tdata; + BEGIN + Result:=export_noerror; + subfile:=1; + + LoadDatFilePart(fileid,$10,SizeOf(width),@width); + LoadDatFilePart(fileid,$12,SizeOf(height),@height); + LoadDatFilePart(fileid,$18,SizeOf(cols),@cols); + LoadDatFilePart(fileid,$1A,SizeOf(rows),@rows); + ExportDefLine(fileid,'WIDTH:'+FormatNumber(width,4,'0'),False); + ExportDefLine(fileid,'HEIGHT:'+FormatNumber(height,4,'0'),False); + ExportDefLine(fileid,'COLS:'+FormatNumber(cols,2,'0'),False); + ExportDefLine(fileid,'ROWS:'+FormatNumber(rows,2,'0'),False); + + LoadDatFilePart(fileid,$1C,SizeOf(linkcount),@linkcount); + ExportDefLine(fileid,'TXMPLINKS:'+FormatNumber(linkcount,4,'0'),False); + FOR i:=0 TO linkcount-1 DO BEGIN + LoadDatFilePart(fileid,$20+i*4,SizeOf(link),@link); + link:=link DIV 256; + IF link=0 THEN link:=fileid-1; + ExportDefLine(fileid,FormatNumber(i,4,'0')+':LINKtoTXMP:'+FormatNumber(link,5,'0')+':'+dat_files[link].Name+':'+dat_files[link].Extension,False); + END; + + IF convert THEN BEGIN + img:=LoadTXMBconnected(fileid); + data:=ImgdataToBmp(img.imgx,img.imgy,img.imgdepth,img.storetype,img.imgdata); + filestream:=TFileStream.Create(GetExtractPath+'\'+GetWinFileName(fileid,FormatNumber(subfile,2,'0')+'-ImgData')+'.bmp',fmCreate); + filestream.Write(data[0],Length(data)); + filestream.Free; + END; + END; + +FUNCTION ExportTXMP; + VAR + filestream:TFileStream; + subfile:Byte; + img:TImgPackage; + BEGIN + Result:=export_noerror; + subfile:=1; + + img:=LoadImgData(fileid); + { + filestream:=TFileStream.Create(GetExtractPath+'\'+GetWinFileName(fileid,FormatNumber(subfile,2,'0')+'-ImgData'),fmCreate); + filestream.Write(img.imgdata[0],Length(img.imgdata)); + filestream.Free; + } + IF convert THEN BEGIN + img.imgdata:=ImgdataToBMP(img.imgx,img.imgy,img.imgdepth,img.storetype,img.imgdata); + filestream:=TFileStream.Create(GetExtractPath+'\'+GetWinFileName(fileid,FormatNumber(subfile,2,'0')+'-ImgData')+'.bmp',fmCreate); + filestream.Write(img.imgdata[0],Length(img.imgdata)); + filestream.Free; + END; + END; + +END. Index: /oup/releases/0.16a/Unit5_preview.dfm =================================================================== --- /oup/releases/0.16a/Unit5_preview.dfm (revision 21) +++ /oup/releases/0.16a/Unit5_preview.dfm (revision 21) @@ -0,0 +1,74 @@ +object Form5: TForm5 + Left = 0 + Top = 0 + Width = 435 + Height = 348 + BorderStyle = bsSizeToolWin + Caption = 'Preview' + Color = clBtnFace + Font.Charset = DEFAULT_CHARSET + Font.Color = clWindowText + Font.Height = -11 + Font.Name = 'Tahoma' + Font.Style = [] + FormStyle = fsStayOnTop + OldCreateOrder = False + OnCloseQuery = FormCloseQuery + OnCreate = FormCreate + OnResize = FormResize + PixelsPerInch = 96 + TextHeight = 13 + object img: TImage + Left = 0 + Top = 20 + Width = 427 + Height = 304 + Align = alClient + end + object panel_buttons: TPanel + Left = 0 + Top = 0 + Width = 427 + Height = 20 + Align = alTop + BevelOuter = bvNone + TabOrder = 0 + Visible = False + OnResize = panel_buttonsResize + object btn_dec: TButton + Left = 0 + Top = 0 + Width = 20 + Height = 20 + Caption = '-' + Enabled = False + TabOrder = 0 + OnClick = btn_decClick + end + object btn_startstop: TButton + Left = 21 + Top = 0 + Width = 80 + Height = 20 + Caption = 'Stop automatic' + TabOrder = 1 + OnClick = btn_startstopClick + end + object btn_inc: TButton + Left = 102 + Top = 0 + Width = 20 + Height = 20 + Caption = '+' + Enabled = False + TabOrder = 2 + OnClick = btn_incClick + end + end + object timer: TTimer + Enabled = False + OnTimer = timerTimer + Left = 72 + Top = 48 + end +end Index: /oup/releases/0.16a/Unit5_preview.pas =================================================================== --- /oup/releases/0.16a/Unit5_preview.pas (revision 21) +++ /oup/releases/0.16a/Unit5_preview.pas (revision 21) @@ -0,0 +1,183 @@ +UNIT Unit5_preview; +INTERFACE +USES + Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, + Dialogs, Math, ExtCtrls, Unit2_functions, Unit3_data, Unit4_exporters, Unit6_imgfuncs, + StdCtrls; + +TYPE + TForm5 = Class(TForm) + img: TImage; + timer: TTimer; + panel_buttons: TPanel; + btn_dec: TButton; + btn_startstop: TButton; + btn_inc: TButton; + PROCEDURE btn_incClick(Sender: TObject); + PROCEDURE btn_decClick(Sender: TObject); + PROCEDURE FormResize(Sender: TObject); + PROCEDURE btn_startstopClick(Sender: TObject); + PROCEDURE panel_buttonsResize(Sender: TObject); + PROCEDURE timerTimer(Sender: TObject); + PROCEDURE FormCreate(Sender: TObject); + PROCEDURE FormCloseQuery(Sender: TObject; var CanClose: Boolean); + PROCEDURE ShowPreview(fileid:LongWord); + PRIVATE + PUBLIC + END; + +VAR + Form5: TForm5; + +IMPLEMENTATION +{$R *.dfm} +USES Unit1_main; +VAR + memstreams:Array OF TMemoryStream; + actualimg:Byte; + _fileid:LongWord; + +PROCEDURE PreviewTXMB; + VAR + data:Tdata; + img:TImgPackage; + BEGIN + SetLength(memstreams,1); + img:=LoadTXMBconnected(_fileid); + data:=ImgdataToBmp(img.imgx,img.imgy,img.imgdepth,img.storetype,img.imgdata); + + memstreams[0].Clear; + memstreams[0].Write(data[0],Length(data)); + memstreams[0].Seek(0,soFromBeginning); + + Form5.img.Picture.Bitmap.LoadFromStream(memstreams[0]); + END; + +PROCEDURE PreviewTXMP; + VAR + data:Tdata; + img:TImgPackage; + BEGIN + SetLength(memstreams,1); + img:=LoadImgData(_fileid); + data:=ImgdataToBmp(img.imgx,img.imgy,img.imgdepth,img.storetype,img.imgdata); + + memstreams[0].Clear; + memstreams[0].Write(data[0],Length(data)); + memstreams[0].Seek(0,soFromBeginning); + + Form5.img.Picture.Bitmap.LoadFromStream(memstreams[0]); + END; + +PROCEDURE PreviewTXAN; + VAR + loop_speed:Word; + linkcount:LongWord; + link:LongWord; + i:Byte; + data:Tdata; + img:TImgPackage; + BEGIN + LoadDatFilePart(_fileid,$14,SizeOf(loop_speed),@loop_speed); + LoadDatFilePart(_fileid,$1C,SizeOf(linkcount),@linkcount); + SetLength(memstreams,linkcount); + FOR i:=0 TO linkcount-1 DO BEGIN + LoadDatFilePart(_fileid,$20+i*4,SizeOf(link),@link); + link:=link DIV 256; + IF link=0 THEN link:=_fileid-1; + memstreams[i]:=TMemoryStream.Create; + img:=LoadImgData(link); + data:=ImgdataToBmp(img.imgx,img.imgy,img.imgdepth,img.storetype,img.imgdata); + memstreams[i].Clear; + memstreams[i].Write(data[0],Length(data)); + memstreams[i].Seek(0,soFromBeginning); + END; + actualimg:=254; + Form5.timer.Interval:=Floor(loop_speed*(1/60)*1000); + Form5.timer.Enabled:=False; + Form5.btn_startstopClick(Form5); + Form5.panel_buttons.Visible:=True; + END; + +PROCEDURE TForm5.ShowPreview(fileid:LongWord); + BEGIN + _fileid:=fileid; + Form5.timer.Enabled:=False; + Form5.panel_buttons.Visible:=False; + Form5.Caption:='Preview '+dat_files[_fileid].FileName; + IF dat_files[fileid].Extension='TXAN' THEN PreviewTXAN; + IF dat_files[fileid].Extension='TXMB' THEN PreviewTXMB; + IF dat_files[fileid].Extension='TXMP' THEN PreviewTXMP; + END; + +PROCEDURE TForm5.FormCloseQuery(Sender: TObject; var CanClose: Boolean); + BEGIN + CanClose:=False; + Form5.Visible:=False; + END; + +PROCEDURE TForm5.FormCreate(Sender: TObject); + BEGIN + SetLength(memstreams,1); + memstreams[0]:=TMemoryStream.Create; + Form5.Width:=260; + Form5.Height:=300; + END; + +PROCEDURE TForm5.timerTimer(Sender: TObject); + BEGIN + Inc(actualimg); + IF actualimg>=Length(memstreams) THEN actualimg:=0; + Form5.img.Picture.Bitmap.LoadFromStream(memstreams[actualimg]); + memstreams[actualimg].Seek(0,soFromBeginning); + Form5.Caption:='Preview '+dat_files[_fileid].FileName+' ('+IntToStr(actualimg+1)+'/'+IntToStr(Length(memstreams))+')'; + END; + +PROCEDURE TForm5.panel_buttonsResize(Sender: TObject); + BEGIN + btn_startstop.Width:=panel_buttons.Width-45; + btn_inc.Left:=panel_buttons.Width-23; + END; + +PROCEDURE TForm5.btn_startstopClick(Sender: TObject); + BEGIN + Form5.timer.Enabled:=NOT Form5.timer.Enabled; + Form5.btn_dec.Enabled:=NOT Form5.timer.Enabled; + Form5.btn_inc.Enabled:=NOT Form5.timer.Enabled; + IF Form5.timer.Enabled THEN + Form5.btn_startstop.Caption:='Stop automatic' + ELSE + Form5.btn_startstop.Caption:='Start automatic'; + END; + +PROCEDURE TForm5.FormResize(Sender: TObject); + BEGIN + IF Form5.Width>=150 THEN BEGIN + END ELSE Form5.Width:=150; + IF Form5.Height>=150 THEN BEGIN + END ELSE Form5.Height:=150; + END; + +PROCEDURE TForm5.btn_decClick(Sender: TObject); + BEGIN + IF actualimg>0 THEN + Dec(actualimg) + ELSE + actualimg:=High(memstreams); + Form5.Caption:='Preview '+dat_files[_fileid].FileName+' ('+IntToStr(actualimg+1)+'/'+IntToStr(Length(memstreams))+')'; + Form5.img.Picture.Bitmap.LoadFromStream(memstreams[actualimg]); + memstreams[actualimg].Seek(0,soFromBeginning); + END; + +PROCEDURE TForm5.btn_incClick(Sender: TObject); + BEGIN + IF actualimg0) THEN BEGIN + Inc(row_orig); + IF (row_orig MOD 2)=0 THEN BEGIN + Inc(row); + col:=0; + END; + END; + IF (row_orig MOD 2)=0 THEN BEGIN + IF (i MOD 2)=0 THEN BEGIN + FOR j:=0 TO (imgdepth DIV 8)-1 DO + temparray[((row*(oldx DIV 2))+col)*(imgdepth DIV 8)+j]:=data[i*2+j]; + Inc(col); + END; + END; + END; + Result:=temparray; + END; + + +FUNCTION RevertImage(imgx,imgy,imgdepth:LongWord; imgdata:Tdata):Tdata; + VAR + x,y,i:LongWord; + BEGIN + SetLength(Result,imgx*imgy*(imgdepth DIV 8)); + FOR y:=0 TO imgy-1 DO + FOR x:=0 TO imgx-1 DO + FOR i:=0 TO (imgdepth DIV 8)-1 DO + Result[((imgx*(imgy-1-y)+x)*(imgdepth DIV 8))+i]:= + imgdata[(imgx*y+x)*(imgdepth DIV 8)+i]; + END; + + +FUNCTION DecompressImage(imgx,imgy:LongWord; imgdata:Tdata):Tdata; + TYPE + Tcolor=RECORD + RGBb:Byte; + RGBg:Byte; + RGBr:Byte; + RGBa:Byte; + END; + VAR + i,j,x,y:LongWord; + color:Array[1..4] OF Tcolor; + pixel:Array[1..16] OF Byte; + BEGIN + x:=0; + y:=0; + SetLength(Result,imgx*imgy*4); + FOR i:=0 TO ((imgx*imgy) DIV 16)-1 DO BEGIN + Color[1].RGBb:=Floor(((imgdata[(i*8)+0]+imgdata[(i*8)+1]*256) AND $001F) / $001F * 255); + Color[1].RGBg:=Floor(((imgdata[(i*8)+0]+imgdata[(i*8)+1]*256) AND $07E0) / $07E0 * 255); + Color[1].RGBr:=Floor(((imgdata[(i*8)+0]+imgdata[(i*8)+1]*256) AND $F800) / $F800 * 255); + Color[1].RGBa:=255; + Color[2].RGBb:=Floor(((imgdata[(i*8)+2]+imgdata[(i*8)+3]*256) AND $001F) / $001F * 255); + Color[2].RGBg:=Floor(((imgdata[(i*8)+2]+imgdata[(i*8)+3]*256) AND $07E0) / $07E0 * 255); + Color[2].RGBr:=Floor(((imgdata[(i*8)+2]+imgdata[(i*8)+3]*256) AND $F800) / $F800 * 255); + Color[2].RGBa:=255; + Color[3].RGBb:=Floor( Color[1].RGBb/3*2 + Color[2].RGBb/3 ); + Color[3].RGBg:=Floor( Color[1].RGBg/3*2 + Color[2].RGBg/3 ); + Color[3].RGBr:=Floor( Color[1].RGBr/3*2 + Color[2].RGBr/3 ); + Color[3].RGBa:=255; + Color[4].RGBb:=Floor( Color[1].RGBb/3 + Color[2].RGBb/3*2 ); + Color[4].RGBg:=Floor( Color[1].RGBg/3 + Color[2].RGBg/3*2 ); + Color[4].RGBr:=Floor( Color[1].RGBr/3 + Color[2].RGBr/3*2 ); + Color[4].RGBa:=255; + Pixel[1]:=Floor( (imgdata[(i*8)+4] AND $C0) / $40 + 1 ); + Pixel[2]:=Floor( (imgdata[(i*8)+4] AND $30) / $10 + 1 ); + Pixel[3]:=Floor( (imgdata[(i*8)+4] AND $0C) / $04 + 1 ); + Pixel[4]:=Floor( (imgdata[(i*8)+4] AND $03) + 1 ); + Pixel[5]:=Floor( (imgdata[(i*8)+5] AND $C0) / $40 + 1 ); + Pixel[6]:=Floor( (imgdata[(i*8)+5] AND $30) / $10 + 1 ); + Pixel[7]:=Floor( (imgdata[(i*8)+5] AND $0C) / $04 + 1 ); + Pixel[8]:=Floor( (imgdata[(i*8)+5] AND $03) + 1 ); + Pixel[9]:=Floor( (imgdata[(i*8)+6] AND $C0) / $40 + 1 ); + Pixel[10]:=Floor( (imgdata[(i*8)+6] AND $30) / $10 + 1 ); + Pixel[11]:=Floor( (imgdata[(i*8)+6] AND $0C) / $04 + 1 ); + Pixel[12]:=Floor( (imgdata[(i*8)+6] AND $03) + 1 ); + Pixel[13]:=Floor( (imgdata[(i*8)+7] AND $C0) / $40 + 1 ); + Pixel[14]:=Floor( (imgdata[(i*8)+7] AND $30) / $10 + 1 ); + Pixel[15]:=Floor( (imgdata[(i*8)+7] AND $0C) / $04 + 1 ); + Pixel[16]:=Floor( (imgdata[(i*8)+7] AND $03) + 1 ); + FOR j:=0 TO 3 DO BEGIN + Result[((y+3)*imgx+x+j)*3+0]:=Color[Pixel[16-j]].RGBb; + Result[((y+3)*imgx+x+j)*3+1]:=Color[Pixel[16-j]].RGBg; + Result[((y+3)*imgx+x+j)*3+2]:=Color[Pixel[16-j]].RGBr; + END; + FOR j:=0 TO 3 DO BEGIN + Result[((y+2)*imgx+x+j)*3+0]:=Color[Pixel[12-j]].RGBb; + Result[((y+2)*imgx+x+j)*3+1]:=Color[Pixel[12-j]].RGBg; + Result[((y+2)*imgx+x+j)*3+2]:=Color[Pixel[12-j]].RGBr; + END; + FOR j:=0 TO 3 DO BEGIN + Result[((y+1)*imgx+x+j)*3+0]:=Color[Pixel[8-j]].RGBb; + Result[((y+1)*imgx+x+j)*3+1]:=Color[Pixel[8-j]].RGBg; + Result[((y+1)*imgx+x+j)*3+2]:=Color[Pixel[8-j]].RGBr; + END; + FOR j:=0 TO 3 DO BEGIN + Result[((y+0)*imgx+x+j)*3+0]:=Color[Pixel[4-j]].RGBb; + Result[((y+0)*imgx+x+j)*3+1]:=Color[Pixel[4-j]].RGBg; + Result[((y+0)*imgx+x+j)*3+2]:=Color[Pixel[4-j]].RGBr; + END; + x:=x+4; + IF x=imgx THEN BEGIN + y:=y+4; + x:=0; + END; + END; + END; + + +FUNCTION ImgdataToBmp(imgx,imgy,imgdepth,storetype:LongWord; imgdata:Tdata):Tdata; + CONST BMPheader:Array[0..53] OF Byte= + ($42,$4D,0,0,0,0,0,0,0,0,54,0,0,0, + 40,0,0,0,0,0,0,0,0,0,0,0,1,0,$18,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0); + VAR + i,x,y:LongWord; + BEGIN + CASE storetype OF + 0: BEGIN + SetLength(Result,imgx*imgy*3); + FOR y:=0 TO imgy-1 DO BEGIN + FOR x:=0 TO imgx-1 DO BEGIN + Result[((imgx*y+x)*3)+0]:=Floor( ( (imgdata[(imgx*y+x)*2]+imgdata[(imgx*y+x)*2+1]*256) AND $000F ) / $000F * 255); + Result[((imgx*y+x)*3)+1]:=Floor( ( (imgdata[(imgx*y+x)*2]+imgdata[(imgx*y+x)*2+1]*256) AND $00F0 ) / $00F0 * 255); + Result[((imgx*y+x)*3)+2]:=Floor( ( (imgdata[(imgx*y+x)*2]+imgdata[(imgx*y+x)*2+1]*256) AND $0F00 ) / $0F00 * 255); + END; + END; + END; + 1,2: BEGIN + SetLength(Result,imgx*imgy*3); + FOR y:=0 TO imgy-1 DO BEGIN + FOR x:=0 TO imgx-1 DO BEGIN + Result[((imgx*y+x)*3)+0]:=Floor( ( (imgdata[(imgx*y+x)*2]+imgdata[(imgx*y+x)*2+1]*256) AND $001F ) / $001F * 255); + Result[((imgx*y+x)*3)+1]:=Floor( ( (imgdata[(imgx*y+x)*2]+imgdata[(imgx*y+x)*2+1]*256) AND $03E0 ) / $03E0 * 255); + Result[((imgx*y+x)*3)+2]:=Floor( ( (imgdata[(imgx*y+x)*2]+imgdata[(imgx*y+x)*2+1]*256) AND $7C00 ) / $7C00 * 255); + END; + END; + END; + 8: BEGIN + SetLength(Result,imgx*imgy*3); + FOR y:=0 TO imgy-1 DO BEGIN + FOR x:=0 TO imgx-1 DO BEGIN + Result[((imgx*y+x)*3)+0]:=imgdata[(imgx*y+x)*4+0]; + Result[((imgx*y+x)*3)+1]:=imgdata[(imgx*y+x)*4+1]; + Result[((imgx*y+x)*3)+2]:=imgdata[(imgx*y+x)*4+2]; + END; + END; + END; + 9: BEGIN + Result:=DecompressImage(imgx,imgy,imgdata); + END; + END; + Result:=RevertImage(imgx,imgy,24,Result); + SetLength(Result,imgx*imgy*3+54); + FOR i:=High(Result)-54 DOWNTO 0 DO Result[i+54]:=Result[i]; + + FOR i:=0 TO High(BMPheader) DO Result[i]:=BMPheader[i]; + Result[2]:=((imgx*imgy*3+54) AND $000000FF); + Result[3]:=((imgx*imgy*3+54) AND $0000FF00) DIV $100; + Result[4]:=((imgx*imgy*3+54) AND $00FF0000) DIV $10000; + Result[5]:=((imgx*imgy*3+54) AND $FF000000) DIV $1000000; + Result[18]:=(imgx AND $000000FF) DIV $1; + Result[19]:=(imgx AND $0000FF00) DIV $100; + Result[20]:=(imgx AND $00FF0000) DIV $10000; + Result[21]:=(imgx AND $FF000000) DIV $1000000; + Result[22]:=(imgy AND $000000FF) DIV $1; + Result[23]:=(imgy AND $0000FF00) DIV $100; + Result[24]:=(imgy AND $00FF0000) DIV $10000; + Result[25]:=(imgy AND $FF000000) DIV $1000000; + Result[34]:=((imgx*imgy*3) AND $000000FF) DIV $1; + Result[35]:=((imgx*imgy*3) AND $0000FF00) DIV $100; + Result[36]:=((imgx*imgy*3) AND $00FF0000) DIV $10000; + Result[37]:=((imgx*imgy*3) AND $FF000000) DIV $1000000; + END; + +FUNCTION BmpToImgdata(bmpdata:Tdata; _32bit:Boolean):TImgPackage; + VAR + x,y:LongWord; + r24,g24,b24:Word; + r16,g16,b16:Word; + gesamt:Word; + BEGIN + Result.imgdepth:=0; + IF NOT((bmpdata[00]=$42) AND (bmpdata[01]=$4D)) THEN BEGIN + ShowMessage('Not a standard 24bit bitmap'); + Exit; + END; + IF NOT(bmpdata[10]=54) THEN BEGIN + ShowMessage('Imagedata has to start at 0x54'); + Exit; + END; + IF NOT(bmpdata[14]=40) THEN BEGIN + ShowMessage('Second bitmap header has to have 40 bytes'); + Exit; + END; + IF NOT(bmpdata[28]=24) THEN BEGIN + ShowMessage('Bitmap has to have 24bits'); + Exit; + END; + IF NOT(bmpdata[30]=0) THEN BEGIN + ShowMessage('Bitmap has to be uncompressed'); + Exit; + END; + Result.imgx:=bmpdata[18]+bmpdata[19]*256+bmpdata[20]*256*256+bmpdata[21]*256*256*256; + Result.imgy:=bmpdata[22]+bmpdata[23]*256+bmpdata[24]*256*256+bmpdata[25]*256*256*256; + IF _32bit THEN BEGIN + Result.imgdepth:=32; + Result.storetype:=8; + END ELSE BEGIN + Result.imgdepth:=16; + Result.storetype:=1; + END; + + SetLength(Result.imgdata,Result.imgx*Result.imgy*Result.imgdepth DIV 8); + IF _32bit THEN BEGIN + FOR y:=0 TO Result.imgy-1 DO BEGIN + FOR x:=0 TO Result.imgx-1 DO BEGIN + Result.imgdata[((Result.imgx*y+x)*4)+0]:=bmpdata[54+(Result.imgx*y+x)*3+0]; + Result.imgdata[((Result.imgx*y+x)*4)+1]:=bmpdata[54+(Result.imgx*y+x)*3+1]; + Result.imgdata[((Result.imgx*y+x)*4)+2]:=bmpdata[54+(Result.imgx*y+x)*3+2]; + Result.imgdata[((Result.imgx*y+x)*4)+3]:=0; + END; + END; + END ELSE BEGIN + FOR y:=0 TO Result.imgy-1 DO BEGIN + FOR x:=0 TO Result.imgx-1 DO BEGIN + r24:=bmpdata[54+(Result.imgx*y+x)*3+0]; + g24:=bmpdata[54+(Result.imgx*y+x)*3+1]; + b24:=bmpdata[54+(Result.imgx*y+x)*3+2]; + r16:=(Ceil(r24*$001F/255)) AND $001F; + g16:=(Ceil(g24*$03E0/255)) AND $03E0; + b16:=(Ceil(b24*$7C00/255)) AND $7C00; + gesamt:=r16+g16+b16; + Result.imgdata[((Result.imgx*y+x)*2)+0]:=gesamt AND $00FF; + Result.imgdata[((Result.imgx*y+x)*2)+1]:=(gesamt AND $FF00) DIV 256; + END; + END; + END; + + Result.imgdata:=RevertImage(Result.imgx,Result.imgy,Result.imgdepth,Result.imgdata); + END; + +FUNCTION LoadTXMBconnected(fileid:LongWord):TImgPackage; + VAR + i,x,y,x2,y2,pixelid,imgid:LongWord; + rows,cols:Word; + linkcount:LongWord; + link:LongWord; + single_image:TImgPackage; + images_decoded:Array OF TImgPackage; + x_start,y_start:LongWord; + BEGIN + LoadDatFilePart(fileid,$10,SizeOf(Result.imgx),@Result.imgx); + LoadDatFilePart(fileid,$12,SizeOf(Result.imgy),@Result.imgy); + LoadDatFilePart(fileid,$18,SizeOf(cols),@cols); + LoadDatFilePart(fileid,$1A,SizeOf(rows),@rows); + LoadDatFilePart(fileid,$1C,SizeOf(linkcount),@linkcount); + SetLength(images_decoded,linkcount); + FOR i:=0 TO linkcount-1 DO BEGIN + LoadDatFilePart(fileid,$20+i*4,SizeOf(link),@link); + link:=link DIV 256; + single_image:=LoadImgData(link); + images_decoded[i]:=BmpToImgdata(ImgdataToBmp(single_image.imgx,single_image.imgy,single_image.imgdepth,single_image.storetype,single_image.imgdata),False); + END; + SetLength(Result.imgdata,Result.imgx*Result.imgy*2); + FOR y:=0 TO rows-1 DO BEGIN + FOR x:=0 TO cols-1 DO BEGIN + imgid:=y*cols+x; + x_start:=0; + y_start:=0; + FOR i:=0 TO x DO IF i=400 THEN BEGIN + END ELSE Form7.Width:=400; + IF Form7.Height>=350 THEN BEGIN + END ELSE Form7.Height:=350; + END; + +PROCEDURE TForm7.list_txmpClick(Sender: TObject); + VAR + id:LongWord; + data:Tdata; + img:TImgPackage; + mem:TMemoryStream; + fadingbyte,depthbyte,storebyte:Byte; + BEGIN + id:=StrToInt(MidStr(list_txmp.Items.Strings[list_txmp.ItemIndex],1,5)); + + LoadDatFilePart(id,$88,SizeOf(fadingbyte),@fadingbyte); + LoadDatFilePart(id,$89,SizeOf(depthbyte),@depthbyte); + LoadDatFilePart(id,$90,SizeOf(storebyte),@storebyte); + Form7.check_fading.Checked:=(fadingbyte AND $01)>0; + Form7.check_transparency.Checked:=(depthbyte AND $04)>0; + Form7.check_32bit.Checked:=(storebyte=8); + + img:=LoadImgData(id); + data:=ImgdataToBmp(img.imgx,img.imgy,img.imgdepth,img.storetype,img.imgdata); + + mem:=TMemoryStream.Create; + mem.Write(data[0],Length(data)); + mem.Seek(0,soFromBeginning); + Form7.image_txmppreview.Picture.Bitmap.LoadFromStream(mem); + mem.Free; + + Form7.group_bmpselect.Enabled:=True; + END; + +PROCEDURE TForm7.btn_loadClick(Sender: TObject); + VAR + bmpfile:TFileStream; + mem:TMemoryStream; + BEGIN + IF opend.Execute THEN BEGIN + bmpfile:=TFileStream.Create(opend.FileName, fmOpenRead); + SetLength(actual_bmpdata,bmpfile.Size); + bmpfile.Read(actual_bmpdata[0],bmpfile.Size); + bmpfile.Free; + + mem:=TMemoryStream.Create; + mem.Write(actual_bmpdata[0],Length(actual_bmpdata)); + mem.Seek(0,soFromBeginning); + Form7.image_bmppreview.Picture.Bitmap.LoadFromStream(mem); + mem.Free; + + Form7.group_options.Enabled:=True; + END; + END; + +PROCEDURE TForm7.btn_replaceClick(Sender: TObject); + VAR + id:LongWord; + imgpkg:TImgPackage; + rawfile:TFileStream; + datfile:TFileStream; + dataddr:LongWord; + old_rawaddr,new_rawaddr:LongWord; + oldwidth,oldheight:Word; + oldstore,olddepth,oldfading:Byte; + oldsize:LongWord; + newsize:LongWord; + datbyte:Word; + BEGIN + IF Form7.list_txmp.ItemIndex>=0 THEN BEGIN + imgpkg:=BmpToImgdata(actual_bmpdata,check_32bit.Checked); + datfile:=TFileStream.Create(dat_filename,fmOpenReadWrite); + + id:=StrToInt(MidStr(list_txmp.Items.Strings[list_txmp.ItemIndex],1,5)); + dataddr:=dat_files[id].dataddr; + datfile.Seek(dataddr+$8C,soFromBeginning); + datfile.Read(oldwidth,2); + datfile.Seek(dataddr+$8E,soFromBeginning); + datfile.Read(oldheight,2); + datfile.Seek(dataddr+$88,soFromBeginning); + datfile.Read(oldfading,1); + datfile.Seek(dataddr+$89,soFromBeginning); + datfile.Read(olddepth,1); + datfile.Seek(dataddr+$90,soFromBeginning); + datfile.Read(oldstore,1); + datfile.Seek(dataddr+$9C,soFromBeginning); + datfile.Read(old_rawaddr,4); + IF (oldwidth<>imgpkg.imgx) OR (oldheight<>imgpkg.imgy) THEN BEGIN + IF MessageBox(Form7.Handle, + PChar('Current image and new image have different size'+CrLf+ + '(Current: '+IntToStr(oldwidth)+'x'+IntToStr(oldheight)+ + ' - New: '+IntToStr(imgpkg.imgx)+'x'+IntToStr(imgpkg.imgy)+')'+CrLf+ + 'Replace anyways?'), + PChar(list_txmp.Items.Strings[list_txmp.ItemIndex]), + MB_YESNO)=IDNO THEN Exit; + END; + + rawfile:=TFileStream.Create(raw_filename,fmOpenReadWrite); + + CASE oldstore OF + 9: oldsize:=GetImageDataSize(oldwidth,oldheight,8,(oldfading AND $01)>0); + 0,1,2: oldsize:=GetImageDataSize(oldwidth,oldheight,16,(oldfading AND $01)>0); + 8: oldsize:=GetImageDataSize(oldwidth,oldheight,32,(oldfading AND $01)>0); + ELSE + oldsize:=0; + END; + IF check_32bit.Checked THEN + newsize:=GetImageDataSize(imgpkg.imgx,imgpkg.imgy,32,Form7.check_fading.Checked) + ELSE + newsize:=GetImageDataSize(imgpkg.imgx,imgpkg.imgy,16,Form7.check_fading.Checked); + + IF newsize<=oldsize THEN + new_rawaddr:=old_rawaddr + ELSE + new_rawaddr:=rawfile.Size; + + datbyte:=$00; + IF Form7.check_fading.Checked THEN datbyte:=datbyte OR $01; + datfile.Seek(dataddr+$88,soFromBeginning); + datfile.Write(datbyte,1); + datbyte:=$10; + IF Form7.check_transparency.Checked THEN datbyte:=datbyte OR $04; + datfile.Seek(dataddr+$89,soFromBeginning); + datfile.Write(datbyte,1); + datfile.Seek(dataddr+$8C,soFromBeginning); + datfile.Write(imgpkg.imgx,2); + datfile.Seek(dataddr+$8E,soFromBeginning); + datfile.Write(imgpkg.imgy,2); + IF check_32bit.Checked THEN + datbyte:=$08 + ELSE + datbyte:=$01; + datfile.Seek(dataddr+$90,soFromBeginning); + datfile.Write(datbyte,1); + datfile.Seek(dataddr+$9C,soFromBeginning); + datfile.Write(new_rawaddr,4); + datfile.Free; + + IF Form7.check_fading.Checked THEN BEGIN + imgpkg.imgdata:=CreateFadedImage(imgpkg); + END; + + rawfile.Seek(new_rawaddr,soFromBeginning); + rawfile.Write(imgpkg.imgdata[0],Length(imgpkg.imgdata)); + rawfile.Free; + + ShowMessage('TXMP-image replaced'); + END; + END; + +END. Index: /oup/releases/0.16a/Unit8_binedit.dfm =================================================================== --- /oup/releases/0.16a/Unit8_binedit.dfm (revision 21) +++ /oup/releases/0.16a/Unit8_binedit.dfm (revision 21) @@ -0,0 +1,74 @@ +object Form8: TForm8 + Left = 0 + Top = 0 + AutoScroll = False + BorderStyle = bsSizeToolWin + Caption = 'Form8' + ClientHeight = 617 + ClientWidth = 714 + Color = clBtnFace + Font.Charset = DEFAULT_CHARSET + Font.Color = clWindowText + Font.Height = -11 + Font.Name = 'Tahoma' + Font.Style = [] + OldCreateOrder = False + OnCloseQuery = FormCloseQuery + OnCreate = FormCreate + PixelsPerInch = 96 + TextHeight = 13 + object Splitter1: TSplitter + Left = 161 + Top = 0 + Width = 9 + Height = 617 + Beveled = True + end + object hex: TMPHexEditor + Left = 170 + Top = 0 + Width = 544 + Height = 617 + Cursor = crIBeam + Align = alClient + Font.Charset = DEFAULT_CHARSET + Font.Color = clWindowText + Font.Height = -16 + Font.Name = 'Courier' + Font.Style = [] + ParentFont = False + ScrollBars = ssVertical + TabOrder = 1 + BytesPerRow = 16 + Translation = tkASCII + OffsetFormat = '6!10:0x|' + Colors.Background = clWindow + Colors.ChangedBackground = clWindow + Colors.ChangedText = clRed + Colors.CursorFrame = clNavy + Colors.Offset = clBlack + Colors.OddColumn = clBlue + Colors.EvenColumn = clNavy + Colors.CurrentOffsetBackground = clBtnShadow + Colors.OffsetBackGround = clBtnFace + Colors.CurrentOffset = clBtnHighlight + Colors.Grid = clBtnFace + Colors.NonFocusCursorFrame = clAqua + Colors.ActiveFieldBackground = clWindow + FocusFrame = True + AllowInsertMode = False + DrawGridLines = False + Version = 'May 23, 2005; '#169' markus stephany, vcl[at]mirkes[dot]de' + ShowPositionIfNotFocused = True + end + object list: TListBox + Left = 0 + Top = 0 + Width = 161 + Height = 617 + Align = alLeft + ItemHeight = 13 + TabOrder = 0 + OnClick = listClick + end +end Index: /oup/releases/0.16a/Unit8_binedit.pas =================================================================== --- /oup/releases/0.16a/Unit8_binedit.pas (revision 21) +++ /oup/releases/0.16a/Unit8_binedit.pas (revision 21) @@ -0,0 +1,77 @@ +UNIT Unit8_binedit; +INTERFACE +USES + Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, + Dialogs, Wrapgrid, StdCtrls, Grids, StrUtils, MPHexEditor, Unit3_data, Unit2_functions, + ExtCtrls; + +TYPE + TForm8 = Class(TForm) + list: TListBox; + hex: TMPHexEditor; + Splitter1: TSplitter; + PROCEDURE listClick(Sender: TObject); + PROCEDURE FormCloseQuery(Sender: TObject; var CanClose: Boolean); + PROCEDURE FormCreate(Sender: TObject); + PROCEDURE Recreatelist; + PRIVATE + PUBLIC + END; + +VAR + Form8: TForm8; + +IMPLEMENTATION +{$R *.dfm} +VAR + fileid:LongWord; + +PROCEDURE TForm8.Recreatelist; + VAR + i:LongWord; + BEGIN + Form8.list.Items.Clear; + FOR i:=0 TO dat_header.Files-1 DO BEGIN + IF (dat_files[i].FileType AND $02)=0 THEN + Form8.list.Items.Add(dat_files[i].FileName); + END; + END; + +PROCEDURE TForm8.FormCreate(Sender: TObject); + BEGIN + Form8.Caption:=''; + fileid:=0; + END; + +PROCEDURE TForm8.FormCloseQuery(Sender: TObject; var CanClose: Boolean); + BEGIN + CanClose:=False; + Form8.Visible:=False; + END; + +PROCEDURE TForm8.listClick(Sender: TObject); + VAR + mem:TMemoryStream; + data:Tdata; + BEGIN + IF hex.Modified THEN BEGIN + IF MessageBox(Form8.Handle,PChar('Save changes to file '+dat_files[fileid].FileName+'?'),PChar('Data changed...'),MB_YESNO)=IDYES THEN BEGIN + mem:=TMemoryStream.Create; + hex.SaveToStream(mem); + mem.Seek(0,soFromBeginning); + SetLength(data,mem.Size); + mem.Read(data[0],mem.Size); + mem.Free; + SaveDatFile(fileid,data); + ShowMessage('Changes saved...'); + END; + END; + fileid:=StrToInt(MidStr(list.Items.Strings[list.ItemIndex],1,5)); + data:=LoadDatFile(fileid); + mem:=TMemoryStream.Create; + mem.Write(data[0],Length(data)); + hex.LoadFromStream(mem); + mem.Free; + END; + +END. Index: /oup/releases/0.17a/OniUnPacker.bdsproj =================================================================== --- /oup/releases/0.17a/OniUnPacker.bdsproj (revision 21) +++ /oup/releases/0.17a/OniUnPacker.bdsproj (revision 21) @@ -0,0 +1,171 @@ + + + + + + + + + + + + OniUnPacker.dpr + + + 7.0 + + + 8 + 0 + 1 + 1 + 0 + 0 + 1 + 1 + 1 + 0 + 0 + 1 + 0 + 1 + 1 + 1 + 0 + 0 + 0 + 0 + 0 + 1 + 0 + 1 + 1 + 1 + True + True + WinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE; + + False + + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + False + False + False + True + True + True + + + 0 + 0 + 1 + False + False + False + 16384 + 1048576 + 4194304 + + + + + + + + + xmlrtl;rtl;vcl;vclie;inet;inetdbbde;inetdbxpress;vclx;IndySystem;IndyCore;dbrtl;dsnap;soaprtl;IndyProtocols;bdertl;vcldbx;vcldb;webdsnap;websnap;vclactnband;GridPackd2005;TWrapGrid;Package1;A406_R70;CoolTrayIcon_D6plus + + + False + + + + + + False + + + + + + False + + + False + False + 1 + 0 + 0 + 0 + False + False + False + False + False + 1031 + 1252 + + + + + 1.0.0.0 + + + + + + 1.0.0.0 + + + (untitled) + Borland Web Wizard Package + + + Index: /oup/releases/0.17a/OniUnPacker.cfg =================================================================== --- /oup/releases/0.17a/OniUnPacker.cfg (revision 21) +++ /oup/releases/0.17a/OniUnPacker.cfg (revision 21) @@ -0,0 +1,38 @@ +-$A8 +-$B- +-$C+ +-$D+ +-$E- +-$F- +-$G+ +-$H+ +-$I+ +-$J- +-$K- +-$L+ +-$M- +-$N+ +-$O+ +-$P+ +-$Q- +-$R- +-$S- +-$T- +-$U- +-$V+ +-$W- +-$X+ +-$YD +-$Z1 +-cg +-AWinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE; +-H+ +-W+ +-M +-$M16384,1048576 +-K$00400000 +-LE"C:\Dokumente und Einstellungen\Administrator\Eigene Dateien\Borland Studio Projects\Bpl" +-LN"C:\Dokumente und Einstellungen\Administrator\Eigene Dateien\Borland Studio Projects\Bpl" +-w-UNSAFE_TYPE +-w-UNSAFE_CODE +-w-UNSAFE_CAST Index: /oup/releases/0.17a/OniUnPacker.dpr =================================================================== --- /oup/releases/0.17a/OniUnPacker.dpr (revision 21) +++ /oup/releases/0.17a/OniUnPacker.dpr (revision 21) @@ -0,0 +1,23 @@ +PROGRAM OniUnPacker; +uses + Forms, + Unit1_main in 'Unit1_main.pas' {Form1}, + Unit2_functions in 'Unit2_functions.pas', + Unit3_data in 'Unit3_data.pas', + Unit4_Exporters in 'Unit4_Exporters.pas', + Unit5_preview in 'Unit5_preview.pas' {Form5}, + Unit6_imgfuncs in 'Unit6_imgfuncs.pas', + Unit7_txmpreplace in 'Unit7_txmpreplace.pas' {Form7}, + Unit8_binedit in 'Unit8_binedit.pas' {Form8}; + +{$R *.res} + +BEGIN + Application.Initialize; + Application.Title:='Oni Un/Packer'; + Application.CreateForm(TForm1, Form1); + Application.CreateForm(TForm5, Form5); + Application.CreateForm(TForm7, Form7); + Application.CreateForm(TForm8, Form8); + Application.Run; +END. Index: /oup/releases/0.17a/SQLite3.pas =================================================================== --- /oup/releases/0.17a/SQLite3.pas (revision 21) +++ /oup/releases/0.17a/SQLite3.pas (revision 21) @@ -0,0 +1,120 @@ +unit SQLite3; + +{ + Simplified interface for SQLite. + Updated for Sqlite 3 by Tim Anderson (tim@itwriting.com) + Note: NOT COMPLETE for version 3, just minimal functionality + Adapted from file created by Pablo Pissanetzky (pablo@myhtpc.net) + which was based on SQLite.pas by Ben Hochstrasser (bhoc@surfeu.ch) +} + +interface + +const +// Return values for sqlite3_exec() and sqlite3_step() + +SQLITE_OK = 0; // Successful result +SQLITE_ERROR = 1; // SQL error or missing database +SQLITE_INTERNAL = 2; // An internal logic error in SQLite +SQLITE_PERM = 3 ; // Access permission denied +SQLITE_ABORT = 4; // Callback routine requested an abort +SQLITE_BUSY = 5; // The database file is locked +SQLITE_LOCKED = 6; // A table in the database is locked +SQLITE_NOMEM = 7; // A malloc() failed +SQLITE_READONLY = 8; // Attempt to write a readonly database +SQLITE_INTERRUPT = 9; // Operation terminated by sqlite3_interrupt() +SQLITE_IOERR = 10; // Some kind of disk I/O error occurred +SQLITE_CORRUPT = 11; // The database disk image is malformed +SQLITE_NOTFOUND = 12; // (Internal Only) Table or record not found +SQLITE_FULL = 13; // Insertion failed because database is full +SQLITE_CANTOPEN = 14; // Unable to open the database file +SQLITE_PROTOCOL = 15; // Database lock protocol error +SQLITE_EMPTY = 16; // Database is empty +SQLITE_SCHEMA = 17; // The database schema changed +SQLITE_TOOBIG = 18; // Too much data for one row of a table +SQLITE_CONSTRAINT = 19; // Abort due to contraint violation +SQLITE_MISMATCH = 20; // Data type mismatch +SQLITE_MISUSE = 21; // Library used incorrectly +SQLITE_NOLFS = 22; // Uses OS features not supported on host +SQLITE_AUTH = 23; // Authorization denied +SQLITE_FORMAT = 24; // Auxiliary database format error +SQLITE_RANGE = 25; // 2nd parameter to sqlite3_bind out of range +SQLITE_NOTADB = 26; // File opened that is not a database file +SQLITE_ROW = 100; // sqlite3_step() has another row ready +SQLITE_DONE = 101; // sqlite3_step() has finished executing + +SQLITE_INTEGER = 1; +SQLITE_FLOAT = 2; +SQLITE_TEXT = 3; +SQLITE_BLOB = 4; +SQLITE_NULL = 5; + +type +TSQLiteDB = Pointer; +TSQLiteResult = ^PChar; +TSQLiteStmt = Pointer; + +function SQLite3_Open (dbname: PChar; var db: TSqliteDB): integer; cdecl; external 'sqlite3.dll' name 'sqlite3_open'; +function SQLite3_Close (db: TSQLiteDB): integer; cdecl; external 'sqlite3.dll' name 'sqlite3_close'; +function SQLite3_Exec (db: TSQLiteDB; SQLStatement: PChar; CallbackPtr: Pointer; Sender: TObject; var ErrMsg: PChar): integer; cdecl; external 'sqlite3.dll' name 'sqlite3_exec'; +function SQLite3_Version (): PChar; cdecl; external 'sqlite3.dll' name 'sqlite3_libversion'; +function SQLite3_ErrMsg (db: TSQLiteDB): PChar; cdecl; external 'sqlite3.dll' name 'sqlite3_errmsg'; +function SQLite3_ErrCode (db: TSQLiteDB): integer; cdecl; external 'sqlite3.dll' name 'sqlite3_errcode'; +procedure SQlite3_Free (P: PChar); cdecl; external 'sqlite3.dll' name 'sqlite3_free'; +function SQLite3_GetTable (db: TSQLiteDB; SQLStatement: PChar; var ResultPtr: TSQLiteResult; var RowCount: Cardinal; var ColCount: Cardinal; var ErrMsg: PChar): integer; cdecl; external 'sqlite3.dll' name 'sqlite3_get_table'; +procedure SQLite3_FreeTable (Table:TSQLiteResult ); cdecl; external 'sqlite3.dll' name 'sqlite3_free_table'; +function SQLite3_Complete (P: PChar): boolean; cdecl; external 'sqlite3.dll' name 'sqlite3_complete'; +function SQLite3_LastInsertRowID(db: TSQLiteDB): int64; cdecl; external 'sqlite3.dll' name 'sqlite3_last_insert_rowid'; +procedure SQLite3_Interrupt (db: TSQLiteDB); cdecl; external 'sqlite3.dll' name 'sqlite3_interrupt'; +procedure SQLite3_BusyHandler (db: TSQLiteDB; CallbackPtr: Pointer; Sender: TObject); cdecl; external 'sqlite3.dll' name'sqlite3_busy_handler' ; +procedure SQLite3_BusyTimeout (db: TSQLiteDB; TimeOut: integer); cdecl; external 'sqlite3.dll' name 'sqlite3_busy_timeout'; +function SQLite3_Changes (db: TSQLiteDB): integer; cdecl; external 'sqlite3.dll' name 'sqlite3_changes'; +function SQLite3_TotalChanges (db: TSQLiteDB): integer; cdecl; external 'sqlite3.dll' name 'sqlite3_total_changes'; +function SQLite3_Prepare (db: TSQLiteDB; SQLStatement: PChar; nBytes: integer; var hStmt: TSqliteStmt; var pzTail: PChar): integer; cdecl; external 'sqlite3.dll' name 'sqlite3_prepare'; +function SQLite3_ColumnCount (hStmt: TSqliteStmt): integer; cdecl; external 'sqlite3.dll' name 'sqlite3_column_count'; +function Sqlite3_ColumnName (hStmt: TSqliteStmt; ColNum: integer): pchar; cdecl; external 'sqlite3.dll' name 'sqlite3_column_name'; +function Sqlite3_ColumnDeclType (hStmt: TSqliteStmt; ColNum: integer): pchar; cdecl; external 'sqlite3.dll' name 'sqlite3_column_decltype'; +function Sqlite3_Step (hStmt: TSqliteStmt): integer; cdecl; external 'sqlite3.dll' name 'sqlite3_step'; +function SQLite3_DataCount (hStmt: TSqliteStmt): integer; cdecl; external 'sqlite3.dll' name 'sqlite3_data_count'; + +function Sqlite3_ColumnBlob (hStmt: TSqliteStmt; ColNum: integer):pointer; cdecl; external 'sqlite3.dll' name 'sqlite3_column_blob'; +function Sqlite3_ColumnBytes (hStmt: TSqliteStmt; ColNum: integer): integer; cdecl; external 'sqlite3.dll' name 'sqlite3_column_bytes'; +function Sqlite3_ColumnDouble (hStmt: TSqliteStmt; ColNum: integer): double; cdecl; external 'sqlite3.dll' name 'sqlite3_column_double'; +function Sqlite3_ColumnInt (hStmt: TSqliteStmt; ColNum: integer): integer; cdecl; external 'sqlite3.dll' name 'sqlite3_column_int'; +function Sqlite3_ColumnText (hStmt: TSqliteStmt; ColNum: integer): pchar; cdecl; external 'sqlite3.dll' name 'sqlite3_column_text'; +function Sqlite3_ColumnType (hStmt: TSqliteStmt; ColNum: integer): integer; cdecl; external 'sqlite3.dll' name 'sqlite3_column_type'; + // function Sqlite3_ColumnInt64 (hStmt: TSqliteStmt; ColNum: integer): SqliteInt64; cdecl; external 'sqlite3.dll' name 'sqlite3_column_int64'; +function SQLite3_Finalize (hStmt: TSqliteStmt): integer; cdecl; external 'sqlite3.dll' name 'sqlite3_finalize'; +function SQLite3_Reset (hStmt: TSqliteStmt): integer; cdecl; external 'sqlite3.dll' name 'sqlite3_reset'; + +// +// In the SQL strings input to sqlite3_prepare() and sqlite3_prepare16(), +// one or more literals can be replace by a wildcard "?" or ":N:" where +// N is an integer. These value of these wildcard literals can be set +// using the routines listed below. +// +// In every case, the first parameter is a pointer to the sqlite3_stmt +// structure returned from sqlite3_prepare(). The second parameter is the +// index of the wildcard. The first "?" has an index of 1. ":N:" wildcards +// use the index N. +// + // The fifth parameter to sqlite3_bind_blob(), sqlite3_bind_text(), and + //sqlite3_bind_text16() is a destructor used to dispose of the BLOB or +//text after SQLite has finished with it. If the fifth argument is the +// special value SQLITE_STATIC, then the library assumes that the information +// is in static, unmanaged space and does not need to be freed. If the +// fifth argument has the value SQLITE_TRANSIENT, then SQLite makes its +// own private copy of the data. +// +// The sqlite3_bind_* routine must be called before sqlite3_step() after +// an sqlite3_prepare() or sqlite3_reset(). Unbound wildcards are interpreted +// as NULL. +// + +function SQLite3_BindBlob(hStmt: TSqliteStmt; ParamNum: integer; +ptrData: pointer; numBytes: integer; ptrDestructor: pointer): integer; +cdecl; external 'sqlite3.dll' name 'sqlite3_bind_blob'; + +implementation + +end. Index: /oup/releases/0.17a/SQLiteTable3.pas =================================================================== --- /oup/releases/0.17a/SQLiteTable3.pas (revision 21) +++ /oup/releases/0.17a/SQLiteTable3.pas (revision 21) @@ -0,0 +1,883 @@ +unit SQLiteTable3; + +{ + Simple classes for using SQLite's exec and get_table. + + TSQLiteDatabase wraps the calls to open and close an SQLite database. + It also wraps SQLite_exec for queries that do not return a result set + + TSQLiteTable wraps sqlite_get_table. + It allows accessing fields by name as well as index and can step through a + result set with the Next procedure. + + Adapted by Tim Anderson (tim@itwriting.com) + Originally created by Pablo Pissanetzky (pablo@myhtpc.net) +} + +interface + +uses + Windows, SQLite3, Classes, Sysutils; + +const + dtStr = 0; + dtInt = 1; + dtBool = 2; + dtNumeric = 3; + dtBlob = 4; + +type + + ESQLiteException = class(Exception) + private + public + end; + + TSQLiteTable = class; + + TSQLiteDatabase = class + private + fDB: TSQLiteDB; + fInTrans: Boolean; + procedure RaiseError(s: string; SQL: string); + + public + constructor Create(const FileName: string); + destructor Destroy; override; + function GetTable(const SQL: string): TSQLiteTable; + procedure ExecSQL(const SQL: string); + procedure UpdateBlob(const SQL: string; BlobData: TStream); + procedure BeginTransaction; + procedure Commit; + procedure Rollback; + function TableExists(TableName: string): boolean; + function GetLastInsertRowID: int64; + + published + property isTransactionOpen: boolean read fInTrans; + + end; + + TSQLiteTable = class + private + fResults: TList; + fRowCount: Cardinal; + fColCount: Cardinal; + fCols: TStringList; + fColTypes: TList; + fRow: Cardinal; + + function GetFields(I: Integer): string; + function GetEOF: Boolean; + function GetBOF: Boolean; + function GetColumns(I: Integer): string; + function GetFieldByName(FieldName: string): string; + function GetFieldIndex(FieldName: string): integer; + function GetCount: Integer; + function GetCountResult: Integer; + + + public + constructor Create(DB: TSQLiteDatabase; const SQL: string); + destructor Destroy; override; + function FieldAsInteger(FieldName: string): integer; + function FieldAsBool(FieldName: string): boolean; + function FieldAsBlob(FieldName: string): TMemoryStream; + function FieldAsBlobText(FieldName: string): string; + function FieldIsNull(FieldName: string): boolean; + function FieldAsString(FieldName: string): string; + function FieldAsDouble(FieldName: string): double; +{ function FieldAsInteger(I: integer): integer; + function FieldAsBool(I: integer): boolean; + function FieldAsBlob(I: Integer): TMemoryStream; + function FieldAsBlobText(I: Integer): string; + function FieldIsNull(I: integer): boolean; + function FieldAsString(I: Integer): string; + function FieldAsDouble(I: Integer): double; +} function Next: Boolean; + function Previous: Boolean; + property EOF: Boolean read GetEOF; + property BOF: Boolean read GetBOF; + property Fields[I: Integer]: string read GetFields; + property FieldByName[FieldName: string]: string read GetFieldByName; + property FieldIndex[FieldName: string]: integer read GetFieldIndex; + property Columns[I: Integer]: string read GetColumns; + property ColCount: Cardinal read fColCount; + property RowCount: Cardinal read fRowCount; + property Row: Cardinal read fRow; + function MoveFirst: boolean; + function MoveLast: boolean; + + + property Count: Integer read GetCount; + + // The property CountResult is used when you execute count(*) queries. + // It returns 0 if the result set is empty or the value of the + // first field as an integer. + property CountResult: Integer read GetCountResult; + end; + + +procedure DisposePointer(ptr: pointer); cdecl; + +implementation + +uses + strutils; + + +procedure DisposePointer(ptr: pointer); cdecl; +begin + + if assigned(ptr) then + begin freemem(ptr) end; + +end; + +//------------------------------------------------------------------------------ +// TSQLiteDatabase +//------------------------------------------------------------------------------ + +constructor TSQLiteDatabase.Create(const FileName: string); +var + Msg: pchar; + iResult: integer; +begin + inherited Create; + + self.fInTrans := false; + + Msg := nil; + try + iResult := SQLite3_Open(PChar(FileName), Fdb); + + if iResult <> SQLITE_OK then + begin + if Assigned(Fdb) then + begin + Msg := Sqlite3_ErrMsg(Fdb); + raise ESqliteException.CreateFmt('Failed to open database "%s" : %s', [FileName, Msg]); + end + else + begin raise ESqliteException.CreateFmt('Failed to open database "%s" : unknown error', [FileName]) end; + end; + + //set a few configs + self.ExecSQL('PRAGMA SYNCHRONOUS=NORMAL;'); + + //this pragma not recommended and may disappear in future + //sqlite versions + //self.ExecSQL('PRAGMA full_column_names = 1;'); + + finally + if Assigned(Msg) then + begin SQLite3_Free(Msg) end; + end; + + +end; + + +//.............................................................................. + +destructor TSQLiteDatabase.Destroy; +begin + + if self.fInTrans then + begin self.ExecSQL('ROLLBACK;') end; //assume rollback + + if Assigned(fDB) then + begin SQLite3_Close(fDB) end; + + inherited; +end; + +function TSQLiteDatabase.GetLastInsertRowID: int64; +begin + result := Sqlite3_LastInsertRowID(self.fDB); +end; + +//.............................................................................. + +procedure TSQLiteDatabase.RaiseError(s: string; SQL: string); +//look up last error and raise and exception with an appropriate message +var + Msg: PChar; +begin + + Msg := nil; + + if sqlite3_errcode(self.fDB) <> SQLITE_OK then + Msg := sqlite3_errmsg(self.fDB); + + if Msg <> nil then + raise ESqliteException.CreateFmt(s + ' "%s" : %s', [SQL, Msg]) + else + raise ESqliteException.CreateFmt(s, [SQL, 'No message']); + +end; + +procedure TSQLiteDatabase.ExecSQL(const SQL: string); +var + Stmt: TSQLiteStmt; + NextSQLStatement: Pchar; + iStepResult: integer; +begin + try + + if Sqlite3_Prepare(self.fDB, PChar(SQL), -1, Stmt, NextSQLStatement) <> SQLITE_OK then + begin RaiseError('Error executing SQL', SQL) end; + + if (Stmt = nil) then + begin RaiseError('Could not prepare SQL statement', SQL) end; + + iStepResult := Sqlite3_step(Stmt); + + if (iStepResult <> SQLITE_DONE) then + begin RaiseError('Error executing SQL statement', SQL) end; + + finally + + if Assigned(Stmt) then + begin Sqlite3_Finalize(stmt) end; + + end; +end; + +procedure TSQLiteDatabase.UpdateBlob(const SQL: string; BlobData: TStream); +var + iSize: integer; + ptr: pointer; + Stmt: TSQLiteStmt; + Msg: Pchar; + NextSQLStatement: Pchar; + iStepResult: integer; + iBindResult: integer; +begin +//expects SQL of the form 'UPDATE MYTABLE SET MYFIELD = ? WHERE MYKEY = 1' + + if pos('?', SQL) = 0 then + begin RaiseError('SQL must include a ? parameter', SQL) end; + + Msg := nil; + try + + if Sqlite3_Prepare(self.fDB, PChar(SQL), -1, Stmt, NextSQLStatement) <> SQLITE_OK then + begin RaiseError('Could not prepare SQL statement', SQL) end; + + if (Stmt = nil) then + begin RaiseError('Could not prepare SQL statement', SQL) end; + +//now bind the blob data + iSize := BlobData.size; + + GetMem(ptr, iSize); + + if (ptr = nil) then + begin raise ESqliteException.CreateFmt('Error getting memory to save blob', [SQL, 'Error']) end; + + BlobData.position := 0; + BlobData.Read(ptr^, iSize); + + iBindResult := SQLite3_BindBlob(stmt, 1, ptr, iSize, @DisposePointer); + + if iBindResult <> SQLITE_OK then + begin RaiseError('Error binding blob to database', SQL) end; + + iStepResult := Sqlite3_step(Stmt); + + if (iStepResult <> SQLITE_DONE) then + begin RaiseError('Error executing SQL statement', SQL) end; + + finally + + if Assigned(Stmt) then + begin Sqlite3_Finalize(stmt) end; + + if Assigned(Msg) then + begin SQLite3_Free(Msg) end; + end; + +end; + +//.............................................................................. + +function TSQLiteDatabase.GetTable(const SQL: string): TSQLiteTable; +begin + Result := TSQLiteTable.Create(Self, SQL); +end; + +procedure TSQLiteDatabase.BeginTransaction; +begin + if not self.fInTrans then + begin + self.ExecSQL('BEGIN TRANSACTION;'); + self.fInTrans := true; + end + else + begin raise ESqliteException.Create('Transaction already open') end; +end; + +procedure TSQLiteDatabase.Commit; +begin + self.ExecSQL('COMMIT;'); + self.fInTrans := false; +end; + +procedure TSQLiteDatabase.Rollback; +begin + self.ExecSQL('ROLLBACK;'); + self.fInTrans := false; +end; + +function TSQLiteDatabase.TableExists(TableName: string): boolean; +var + sql: string; + ds: TSqliteTable; +begin +//returns true if table exists in the database + sql := 'select [sql] from sqlite_master where [type] = ''table'' and lower(name) = ''' + lowercase(TableName) + ''' '; + + try + + ds := self.GetTable(sql); + + result := (ds.Count > 0); + + finally + + freeandnil(ds); + + end; + +end; + + +//------------------------------------------------------------------------------ +// TSQLiteTable +//------------------------------------------------------------------------------ + +constructor TSQLiteTable.Create(DB: TSQLiteDatabase; const SQL: string); +var + Stmt: TSQLiteStmt; + NextSQLStatement: Pchar; + iStepResult: integer; + + ptr: pointer; + iNumBytes: integer; + thisBlobValue: TMemoryStream; + thisStringValue: pstring; + thisBoolValue: pBoolean; + thisDoubleValue: pDouble; + thisIntValue: pInteger; + thisColType: pInteger; + i: integer; + DeclaredColType: Pchar; + ActualColType: integer; + ptrValue: Pchar; + +begin + + try + + self.fRowCount := 0; + self.fColCount := 0; + +//if there are several SQL statements in SQL, NextSQLStatment points to the +//beginning of the next one. Prepare only prepares the first SQL statement. + + if Sqlite3_Prepare(Db.fDB, PChar(SQL), -1, Stmt, NextSQLStatement) <> SQLITE_OK then + begin Db.RaiseError('Error executing SQL', SQL) end; + + if (Stmt = nil) then + begin Db.RaiseError('Could not prepare SQL statement', SQL) end; + + iStepResult := Sqlite3_step(Stmt); + + while (iStepResult <> SQLITE_DONE) do + begin + + case iStepResult of + SQLITE_ROW: + begin + + inc(fRowCount); + + if (fRowCount = 1) then + begin + //get data types + fCols := TStringList.Create; + fCols.CaseSensitive := False; + fColTypes := TList.Create; + + fColCount := SQLite3_ColumnCount(stmt); + + for i := 0 to Pred(fColCount) do + begin + fCols.Add(Sqlite3_ColumnName(stmt, i)); + end; + + for i := 0 to Pred(fColCount) do + begin + + new(thisColType); + DeclaredColType := Sqlite3_ColumnDeclType(stmt, i); + + if DeclaredColType = nil then begin + //use the actual column type instead + //seems to be needed for last_insert_rowid + thisColType^ := Sqlite3_ColumnType(stmt, i); + end else begin + DeclaredColType := strupper(DeclaredColType); + + if DeclaredColType = 'INTEGER' then + begin thisColType^ := dtInt end + else + if DeclaredColType = 'BOOLEAN' then + begin thisColType^ := dtBool end + else + if (DeclaredColType = 'NUMERIC') or (DeclaredColType = 'FLOAT') or (DeclaredColType = 'DOUBLE') then + begin thisColType^ := dtNumeric end + else + if DeclaredColType = 'BLOB' then + begin thisColType^ := dtBlob end + else + begin thisColType^ := dtStr end; + end; + + fColTypes.Add(thiscoltype); + end; + + fResults := TList.Create; + + end; + + //get column values + for i := 0 to Pred(ColCount) do + begin + + ActualColType := Sqlite3_ColumnType(stmt, i); + if (ActualColType = SQLITE_NULL) then + begin fResults.Add(nil) end + else + begin + if pInteger(fColTypes[i])^ = dtInt then + begin + new(thisintvalue); + thisintvalue^ := Sqlite3_ColumnInt(stmt, i); + fResults.Add(thisintvalue); + end + else + if pInteger(fColTypes[i])^ = dtBool then + begin + new(thisboolvalue); + thisboolvalue^ := not (Sqlite3_ColumnInt(stmt, i) = 0); + fResults.Add(thisboolvalue); + end + else + if pInteger(fColTypes[i])^ = dtNumeric then + begin + new(thisdoublevalue); + thisdoublevalue^ := Sqlite3_ColumnDouble(stmt, i); + fResults.Add(thisdoublevalue); + end + else + if pInteger(fColTypes[i])^ = dtBlob then + begin + iNumBytes := Sqlite3_ColumnBytes(stmt, i); + + if iNumBytes = 0 then + begin thisblobvalue := nil end + else + begin + thisblobvalue := TMemoryStream.Create; + thisblobvalue.position := 0; + ptr := Sqlite3_ColumnBlob(stmt, i); + thisblobvalue.writebuffer(ptr^, iNumBytes); + end; + fResults.Add(thisblobvalue); + + end + else + begin + new(thisstringvalue); + ptrValue := Sqlite3_ColumnText(stmt, i); + setstring(thisstringvalue^, ptrvalue, strlen(ptrvalue)); + fResults.Add(thisstringvalue); + end; + end; + + end; + + + + end; + + SQLITE_BUSY: + begin raise ESqliteException.CreateFmt('Could not prepare SQL statement', [SQL, 'SQLite is Busy']) end; + else + begin Db.RaiseError('Could not retrieve data', SQL) end; + end; + + iStepResult := Sqlite3_step(Stmt); + + end; + + fRow := 0; + + finally + if Assigned(Stmt) then + begin Sqlite3_Finalize(stmt) end; + end; + +end; + +//.............................................................................. + +destructor TSQLiteTable.Destroy; +var i: integer; + iColNo: integer; +begin + + + if Assigned(fResults) then + begin for i := 0 to fResults.Count - 1 do + begin + //check for blob type + iColNo := (i mod fColCount); + case pInteger(self.fColTypes[iColNo])^ of + dtBlob: + begin + TMemoryStream(fResults[i]).free; + end; + dtStr: + begin + if fResults[i] <> nil then + begin + setstring(string(fResults[i]^), nil, 0); + dispose(fResults[i]); + end; + end; + else + begin + dispose(fResults[i]) + end; + end; + end; + fResults.Free; + end; + + if Assigned(fCols) then + begin fCols.Free end; + + if Assigned(fColTypes) then + begin for i := 0 to fColTypes.Count - 1 do + begin + dispose(fColTypes[i]); + end end; + fColTypes.Free; + inherited; + end; + +//.............................................................................. + +function TSQLiteTable.GetColumns(I: Integer): string; +begin + Result := fCols[I]; +end; + +//.............................................................................. + +function TSQLiteTable.GetCountResult: Integer; +begin + if not EOF then + begin Result := StrToInt(Fields[0]) end + else + begin Result := 0 end; +end; + +function TSQLiteTable.GetCount: Integer; +begin + Result := FRowCount; +end; + +//.............................................................................. + +function TSQLiteTable.GetEOF: Boolean; +begin + Result := fRow >= fRowCount; +end; + +function TSQLiteTable.GetBOF: Boolean; +begin + Result := fRow <= 0; +end; + +//.............................................................................. + +function TSQLiteTable.GetFieldByName(FieldName: string): string; +begin + Result := GetFields(self.GetFieldIndex(FieldName)); +end; + +function TSQLiteTable.GetFieldIndex(FieldName: string): integer; +begin + + if (fCols = nil) then + begin + raise ESqliteException.Create('Field ' + fieldname + ' Not found. Empty dataset'); + exit; + end; + + if (fCols.count = 0) then + begin + raise ESqliteException.Create('Field ' + fieldname + ' Not found. Empty dataset'); + exit; + end; + + result := fCols.IndexOf(FieldName); + + if (result < 0) then + begin raise ESqliteException.Create('Field not found in dataset: ' + fieldname) end; + +end; + +//.............................................................................. + +function TSQLiteTable.GetFields(I: Integer): string; +var + thisvalue: pstring; + ptr: pointer; + thisboolvalue: pBoolean; + thistype: integer; +begin + Result := ''; + + if EOF then + begin raise ESqliteException.Create('Table is at End of File') end; + +//integer and boolean types are not stored in the resultset +//as strings, so they should be retrieved using the type-specific +//methods + + thistype := pInteger(self.fColTypes[I])^; + + if (thistype = dtInt) or (thistype = dtNumeric) or (thistype = dtBlob) then + begin + ptr := self.fResults[(self.frow * self.fColCount) + I]; + + if ptr <> nil then + begin + raise ESqliteException.Create('Use the specific methods for integer, numeric or blob fields'); + end; + + end + else + if pInteger(self.fColTypes[I])^ = dtBool then + begin + thisboolvalue := self.fResults[(self.frow * self.fColCount) + I]; + if thisboolvalue <> nil then + begin if thisboolvalue^ then + begin result := '1' end + else + begin result := '0' end end; + end + + else + + begin + + thisvalue := self.fResults[(self.frow * self.fColCount) + I]; + if (thisvalue <> nil) then + begin Result := thisvalue^ end + else + begin Result := '' end; //return empty string + end; + +end; + +function TSqliteTable.FieldAsBlob(FieldName: string): TMemoryStream; +var + i: Integer; +begin + + if EOF then + begin raise ESqliteException.Create('Table is at End of File') end; + + i:=Self.FieldIndex[FieldName]; + + if (self.fResults[(self.frow * self.fColCount) + I] = nil) then + begin result := nil end + else + if pInteger(self.fColTypes[I])^ = dtBlob then + begin result := TMemoryStream(self.fResults[(self.frow * self.fColCount) + I]) end + else + begin raise ESqliteException.Create('Not a Blob field') end; +end; + +function TSqliteTable.FieldAsBlobText(FieldName: string): string; +var + MemStream: TMemoryStream; + Buffer: PChar; +begin + result := ''; + + MemStream := self.FieldAsBlob(FieldName); + + if MemStream <> nil then + begin if MemStream.Size > 0 then + begin + MemStream.position := 0; + + Buffer := stralloc(MemStream.Size + 1); + MemStream.readbuffer(Buffer[0], MemStream.Size); + (Buffer + MemStream.Size)^ := chr(0); + SetString(Result, Buffer, MemStream.size); + strdispose(Buffer); + end end; + +end; + + +function TSqliteTable.FieldAsInteger(FieldName: string): integer; +var + i: Integer; +begin + + if EOF then + begin raise ESqliteException.Create('Table is at End of File') end; + + i:=Self.FieldIndex[FieldName]; + + if (self.fResults[(self.frow * self.fColCount) + I] = nil) then + begin result := 0 end + else + if pInteger(self.fColTypes[I])^ = dtInt then + begin result := pInteger(self.fResults[(self.frow * self.fColCount) + I])^ end + else + if pInteger(self.fColTypes[I])^ = dtNumeric then + begin result := trunc(strtofloat(pString(self.fResults[(self.frow * self.fColCount) + I])^)) end + else + begin raise ESqliteException.Create('Not an integer or numeric field') end; + +end; + +function TSqliteTable.FieldAsDouble(FieldName: string): double; +var + i: Integer; +begin + + if EOF then + begin raise ESqliteException.Create('Table is at End of File') end; + + i:=Self.FieldIndex[FieldName]; + + if (self.fResults[(self.frow * self.fColCount) + I] = nil) then + begin result := 0 end + else + if pInteger(self.fColTypes[I])^ = dtInt then + begin result := pInteger(self.fResults[(self.frow * self.fColCount) + I])^ end + else + if pInteger(self.fColTypes[I])^ = dtNumeric then + begin result := pDouble(self.fResults[(self.frow * self.fColCount) + I])^ end + else + begin raise ESqliteException.Create('Not an integer or numeric field') end; + +end; + +function TSqliteTable.FieldAsBool(FieldName: string): boolean; +var + i: Integer; +begin + + if EOF then + begin raise ESqliteException.Create('Table is at End of File') end; + + i:=Self.FieldIndex[FieldName]; + + if (self.fResults[(self.frow * self.fColCount) + I] = nil) then + begin result := false end + else + if pInteger(self.fColTypes[I])^ = dtBool then + begin result := pBoolean(self.fResults[(self.frow * self.fColCount) + I])^ end + else + begin raise ESqliteException.Create('Not a boolean field') end; +end; + +function TSqliteTable.FieldAsString(FieldName: string): string; +var + i: Integer; +begin + + if EOF then + begin raise ESqliteException.Create('Table is at End of File') end; + + i:=Self.FieldIndex[FieldName]; + + if (self.fResults[(self.frow * self.fColCount) + I] = nil) then + begin result := '' end + else + begin result := self.GetFields(I) end; + +end; + +function TSqliteTable.FieldIsNull(FieldName: string): boolean; +var + thisvalue: pointer; + i: Integer; +begin + + if EOF then + begin raise ESqliteException.Create('Table is at End of File') end; + + i:=Self.FieldIndex[FieldName]; + + thisvalue := self.fResults[(self.frow * self.fColCount) + I]; + result := (thisvalue = nil); +end; + +//.............................................................................. + +function TSQLiteTable.Next: boolean; +begin + result := false; + if not EOF then + begin + Inc(fRow); + result := true; + end; +end; + +function TSQLiteTable.Previous: boolean; +begin + result := false; + if not BOF then + begin + Dec(fRow); + result := true; + end; +end; + +function TSQLiteTable.MoveFirst: boolean; +begin + result := false; + if self.fRowCount > 0 then + begin + fRow := 0; + result := true; + end; +end; + +function TSQLiteTable.MoveLast: boolean; +begin + result := false; + if self.fRowCount > 0 then + begin + fRow := fRowCount - 1; + result := true; + end; +end; + + +end. + Index: /oup/releases/0.17a/Unit1_main.dfm =================================================================== --- /oup/releases/0.17a/Unit1_main.dfm (revision 21) +++ /oup/releases/0.17a/Unit1_main.dfm (revision 21) @@ -0,0 +1,297 @@ +object Form1: TForm1 + Left = 0 + Top = 0 + HorzScrollBar.Visible = False + VertScrollBar.Visible = False + AutoScroll = False + Caption = 'Form1' + ClientHeight = 563 + ClientWidth = 692 + Color = clBtnFace + Font.Charset = DEFAULT_CHARSET + Font.Color = clWindowText + Font.Height = -11 + Font.Name = 'Tahoma' + Font.Style = [] + Menu = menu + OldCreateOrder = False + OnClose = FormClose + OnCreate = FormCreate + OnResize = FormResize + PixelsPerInch = 96 + TextHeight = 13 + object panel_all: TPanel + Left = 0 + Top = 100 + Width = 692 + Height = 300 + BevelOuter = bvNone + TabOrder = 0 + object Splitter2: TSplitter + Left = 360 + Top = 0 + Width = 8 + Height = 300 + AutoSnap = False + Beveled = True + MinSize = 360 + end + object panel_left: TPanel + Left = 0 + Top = 0 + Width = 360 + Height = 300 + Cursor = crDrag + Align = alLeft + BevelOuter = bvNone + TabOrder = 0 + object Splitter1: TSplitter + Left = 0 + Top = 241 + Width = 360 + Height = 8 + Cursor = crVSplit + Align = alTop + AutoSnap = False + Beveled = True + MinSize = 75 + OnMoved = Splitter1Moved + end + object panel_files: TPanel + Left = 0 + Top = 0 + Width = 360 + Height = 241 + Align = alTop + BevelOuter = bvNone + TabOrder = 0 + object btn_extractconvert: TButton + Left = 1 + Top = 220 + Width = 358 + Height = 20 + Caption = 'Convert and extract file' + Enabled = False + TabOrder = 0 + WordWrap = True + OnClick = btn_extractconvertClick + end + object list_files: TListBox + Left = 0 + Top = 0 + Width = 360 + Height = 218 + Align = alTop + Font.Charset = DEFAULT_CHARSET + Font.Color = clWindowText + Font.Height = -11 + Font.Name = 'Fixedsys' + Font.Style = [] + ItemHeight = 15 + ParentFont = False + TabOrder = 1 + OnClick = list_filesDblClick + OnDblClick = list_filesDblClick + end + end + object list_extensions: TListBox + Left = 0 + Top = 249 + Width = 360 + Height = 51 + Align = alClient + Font.Charset = DEFAULT_CHARSET + Font.Color = clWindowText + Font.Height = -11 + Font.Name = 'Fixedsys' + Font.Style = [] + ItemHeight = 15 + ParentFont = False + Sorted = True + TabOrder = 1 + OnClick = list_extensionsClick + OnDblClick = list_extensionsClick + end + end + object panel_file: TPanel + Left = 368 + Top = 0 + Width = 324 + Height = 300 + Align = alClient + BevelOuter = bvNone + TabOrder = 1 + object lbl_fileinfo: TLabel + Left = 0 + Top = 0 + Width = 324 + Height = 44 + Align = alTop + AutoSize = False + end + object lbl_zerobyte: TLabel + Left = 32 + Top = 136 + Width = 265 + Height = 41 + AutoSize = False + Caption = + 'Zero byte file. Oni will take the data for this file of level0_f' + + 'inal.dat/raw' + Font.Charset = DEFAULT_CHARSET + Font.Color = clWindowText + Font.Height = -16 + Font.Name = 'Tahoma' + Font.Style = [] + ParentFont = False + Visible = False + WordWrap = True + end + object hex: TMPHexEditor + Left = 0 + Top = 44 + Width = 324 + Height = 256 + Cursor = crIBeam + Align = alClient + Font.Charset = DEFAULT_CHARSET + Font.Color = clWindowText + Font.Height = -16 + Font.Name = 'Fixedsys' + Font.Style = [] + ParentFont = False + TabOrder = 0 + BytesPerRow = 16 + Translation = tkAsIs + OffsetFormat = '6!10:0x|' + Colors.Background = clWindow + Colors.ChangedBackground = clWhite + Colors.ChangedText = clRed + Colors.CursorFrame = clNavy + Colors.Offset = clBlack + Colors.OddColumn = clBlue + Colors.EvenColumn = clNavy + Colors.CurrentOffsetBackground = clBtnShadow + Colors.OffsetBackGround = clBtnFace + Colors.CurrentOffset = clBtnHighlight + Colors.Grid = clBtnFace + Colors.NonFocusCursorFrame = clAqua + Colors.ActiveFieldBackground = clWindow + FocusFrame = False + AllowInsertMode = False + DrawGridLines = False + ReadOnlyView = True + Version = 'May 23, 2005; '#169' markus stephany, vcl[at]mirkes[dot]de' + end + end + end + object group_progress: TGroupBox + Left = 296 + Top = 480 + Width = 297 + Height = 57 + Caption = 'Extracting...' + TabOrder = 1 + Visible = False + object lbl_progress: TLabel + Left = 10 + Top = 36 + Width = 279 + Height = 18 + AutoSize = False + end + object progress: TProgressBar + Left = 8 + Top = 16 + Width = 217 + Height = 17 + Step = 1 + TabOrder = 0 + end + object btn_extractcancel: TButton + Left = 232 + Top = 16 + Width = 57 + Height = 33 + Caption = 'Cancel' + TabOrder = 1 + OnClick = btn_extractcancelClick + end + end + object statbar: TStatusBar + Left = 0 + Top = 546 + Width = 692 + Height = 17 + BiDiMode = bdLeftToRight + Panels = < + item + Text = 'Current .dat: -' + Width = 500 + end + item + Text = 'Files: -' + Width = 90 + end + item + Text = 'Extensions: -' + Width = 100 + end> + ParentBiDiMode = False + end + object fopen: TOpenDialog + Filter = 'Oni-Dat-Files|*.dat|Oni-Sep-Files (MAC)|*.sep' + Left = 64 + Top = 120 + end + object menu: TMainMenu + AutoHotkeys = maManual + Left = 224 + object menu_main: TMenuItem + Caption = '&Main' + object menu_loaddat: TMenuItem + Caption = '&Select .dat-file ...' + OnClick = menu_loaddatClick + end + object menu_sep1: TMenuItem + Caption = '-' + end + object menu_exit: TMenuItem + Caption = '&Exit' + OnClick = menu_exitClick + end + end + object menu_extract: TMenuItem + Caption = '&Extract/Convert' + Enabled = False + object menu_extractfile: TMenuItem + Caption = 'Convert and extract current &file' + OnClick = menu_extractfileClick + end + object menu_extractlist: TMenuItem + Caption = 'Convert and extract all files currently in &list' + OnClick = menu_extractlistClick + end + object menu_extractall: TMenuItem + Caption = 'Convert and extract &all files' + OnClick = menu_extractallClick + end + end + object menu_tools: TMenuItem + Caption = '&Tools' + Enabled = False + object menu_preview: TMenuItem + Caption = '&Preview Window ...' + OnClick = menu_previewClick + end + object menu_binedit: TMenuItem + Caption = '&Binary .dat editor ...' + OnClick = menu_bineditClick + end + object menu_txmpreplace: TMenuItem + Caption = '&TXMP replacer ...' + OnClick = menu_txmpreplaceClick + end + end + end +end Index: /oup/releases/0.17a/Unit1_main.pas =================================================================== --- /oup/releases/0.17a/Unit1_main.pas (revision 21) +++ /oup/releases/0.17a/Unit1_main.pas (revision 21) @@ -0,0 +1,439 @@ +UNIT Unit1_main; +INTERFACE +USES + Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, + Dialogs, StdCtrls, StrUtils, Clipbrd, ExtCtrls, ComCtrls, Menus, + Unit2_functions, Unit3_data, Unit5_preview, Unit7_txmpreplace, Unit8_binedit, + Grids, MPHexEditor; + +TYPE + TForm1 = Class(TForm) + panel_all: TPanel; + panel_left: TPanel; + Splitter1: TSplitter; + panel_files: TPanel; + btn_extractconvert: TButton; + list_files: TListBox; + list_extensions: TListBox; + Splitter2: TSplitter; + fopen: TOpenDialog; + group_progress: TGroupBox; + progress: TProgressBar; + lbl_progress: TLabel; + menu: TMainMenu; + menu_main: TMenuItem; + menu_exit: TMenuItem; + menu_preview: TMenuItem; + btn_extractcancel: TButton; + menu_tools: TMenuItem; + menu_txmpreplace: TMenuItem; + menu_extract: TMenuItem; + menu_extractfile: TMenuItem; + menu_extractlist: TMenuItem; + menu_extractall: TMenuItem; + menu_loaddat: TMenuItem; + menu_sep1: TMenuItem; + menu_binedit: TMenuItem; + statbar: TStatusBar; + panel_file: TPanel; + lbl_fileinfo: TLabel; + hex: TMPHexEditor; + lbl_zerobyte: TLabel; + PROCEDURE menu_extractallClick(Sender: TObject); + PROCEDURE menu_extractlistClick(Sender: TObject); + PROCEDURE menu_extractfileClick(Sender: TObject); + PROCEDURE menu_bineditClick(Sender: TObject); + PROCEDURE menu_loaddatClick(Sender: TObject); + PROCEDURE menu_txmpreplaceClick(Sender: TObject); + PROCEDURE menu_exitClick(Sender: TObject); + PROCEDURE btn_extractcancelClick(Sender: TObject); + PROCEDURE menu_previewClick(Sender: TObject); + PROCEDURE Splitter1Moved(Sender: TObject); + PROCEDURE FormClose(Sender: TObject; var Action: TCloseAction); + PROCEDURE btn_hexcopyClick(Sender: TObject); + PROCEDURE list_extensionsClick(Sender: TObject); + PROCEDURE FormResize(Sender: TObject); + PROCEDURE btn_extractconvertClick(Sender: TObject); + PROCEDURE FormCreate(Sender: TObject); + PROCEDURE list_filesDblClick(Sender: TObject); + PROCEDURE btn_loadClick(Sender: TObject); + PRIVATE + PUBLIC + END; + +VAR + Form1: TForm1; + +IMPLEMENTATION +{$R *.dfm} + +PROCEDURE DoAfterLoadOfADat; + VAR + i:LongWord; + txt:Text; + temp4:LongWord; + temp2:Word; + temp1:Byte; + BEGIN + IF NOT DirectoryExists(GetExtractPath) THEN + CreateDir(GetExtractPath); + AssignFile(txt,GetExtractPath+'\___TXMP-FILES___.TXT'); + ReWrite(txt); + FOR i:=0 TO dat_header.Extensions-1 DO BEGIN + IF (dat_extensionsmap[i].Extension[3]='T') AND + (dat_extensionsmap[i].Extension[2]='X') AND + (dat_extensionsmap[i].Extension[1]='M') AND + (dat_extensionsmap[i].Extension[0]='P') THEN BEGIN + WriteLn(txt, FormatNumber(dat_extensionsmap[i].ExtCount,4,'0')+' TXMP-Files'); + Break; + END; + END; + WriteLn(txt,'FileName'+#9+'MipMap'+#9+'Depth'+#9+'ImgX'+#9+'ImgY'+#9+'StoreT'); + FOR i:=0 TO dat_header.Files-1 DO BEGIN + IF dat_files[i].Extension='TXMP' THEN BEGIN + Write(txt,dat_files[i].FileName+#9); + LoadDatFilePart(i,$88,1,@temp1); + Write(txt,IntToHex(temp1,2)+#9); + LoadDatFilePart(i,$89,1,@temp1); + Write(txt,IntToHex(temp1,2)+#9); + LoadDatFilePart(i,$8C,2,@temp2); + Write(txt,IntToHex(temp2,4)+#9); + LoadDatFilePart(i,$8E,2,@temp2); + Write(txt,IntToHex(temp2,4)+#9); + LoadDatFilePart(i,$90,1,@temp1); + Write(txt,IntToHex(temp1,2)+#9); + WriteLn(txt,''); + END; + END; + CloseFile(txt); + + IF NOT DirectoryExists(GetExtractPath) THEN + CreateDir(GetExtractPath); + AssignFile(txt,GetExtractPath+'\___TXAN-FILES___.TXT'); + ReWrite(txt); + FOR i:=0 TO dat_header.Extensions-1 DO BEGIN + IF (dat_extensionsmap[i].Extension[3]='T') AND + (dat_extensionsmap[i].Extension[2]='X') AND + (dat_extensionsmap[i].Extension[1]='A') AND + (dat_extensionsmap[i].Extension[0]='N') THEN BEGIN + WriteLn(txt, FormatNumber(dat_extensionsmap[i].ExtCount,4,'0')+' TXAN-Files'); + Break; + END; + END; + WriteLn(txt,'FileName'+#9+'Loopspeed'+#9+'Unknown'+#9+'Links'); + FOR i:=0 TO dat_header.Files-1 DO BEGIN + IF dat_files[i].Extension='TXAN' THEN BEGIN + Write(txt,dat_files[i].FileName+#9); + LoadDatFilePart(i,$14,2,@temp2); + Write(txt,IntToHex(temp2,4)+#9); + LoadDatFilePart(i,$16,2,@temp2); + Write(txt,IntToHex(temp2,4)+#9); + LoadDatFilePart(i,$1C,4,@temp4); + Write(txt,IntToHex(temp4,8)+#9); + WriteLn(txt,''); + END; + END; + CloseFile(txt); + END; + +PROCEDURE LoadDat; + VAR i:LongWord; + BEGIN + Form1.fopen.InitialDir:=AppSettings.DatPath; + IF Form1.fopen.Execute THEN BEGIN + Form1.Caption:='Oni Un/Packer '+version+' ('+ExtractFileName(Form1.fopen.FileName)+')'; + AppSettings.DatPath:=ExtractFilepath(Form1.fopen.FileName); + Form1.list_files.Items.Clear; + Form1.list_extensions.Items.Clear; + IF LoadDatInfos(Form1.fopen.FileName) THEN BEGIN + Form1.list_extensions.Items.Add('_All files: '+FormatNumber(dat_header.Files,4,' ')); + FOR i:=0 TO dat_header.Extensions-1 DO BEGIN + WITH dat_extensionsmap[i] DO BEGIN + Form1.list_extensions.Items.Add( + Extension[3]+Extension[2]+Extension[1]+Extension[0]+': '+ + FormatNumber(ExtCount,4,' '));{+' (Ident: 0x'+ + IntToHex(Ident[7],2)+IntToHex(Ident[6],2)+IntToHex(Ident[5],2)+IntToHex(Ident[4],2)+IntToHex(Ident[3],2)+IntToHex(Ident[2],2)+IntToHex(Ident[1],2)+IntToHex(Ident[0],2)+')');} + END; + END; + Form1.list_extensions.ItemIndex:=0; + Form1.list_extensionsClick(Form1); + Form1.list_files.ItemIndex:=0; + Form1.list_filesDblClick(Form1); + Form1.statbar.Panels.Items[0].Text:='Current .dat: '+dat_FileName; + Form1.statbar.Panels.Items[1].Text:='Files: '+IntToStr(dat_header.Files); + Form1.statbar.Panels.Items[2].Text:='Extensions: '+IntToStr(dat_header.Extensions); + Form1.menu_tools.Enabled:=True; + Form1.menu_extract.Enabled:=True; + Form1.btn_extractconvert.Enabled:=True; + + Form7.RecreateTXMPlist; + Form8.Recreatelist; + + DoAfterLoadOfADat; + + END ELSE BEGIN + ShowMessage('Error while loading the file:'+CrLf+Form1.fopen.FileName+CrLf+'Perhaps not an Oni-.dat-file?'); + END; + END; + END; + +PROCEDURE TForm1.btn_loadClick(Sender: TObject); + BEGIN + LoadDat; + END; + +PROCEDURE TForm1.list_filesDblClick(Sender: TObject); + VAR + id:LongWord; + temp:Tdata; + mem:TMemoryStream; + BEGIN + id:=StrToInt(MidStr(list_files.Items.Strings[list_files.ItemIndex],1,5)); + IF (dat_files[id].FileType AND $02)=0 THEN BEGIN + lbl_fileinfo.Caption:= + 'Filename: '+dat_files[id].FileName+CrLf+ + 'Size: '+FormatFileSize(dat_files[id].Size)+' ('+IntToStr(dat_files[id].Size)+' Bytes)'+CrLf+ + 'Address in .dat: 0x'+IntTohex(dat_files[id].DatAddr,8); + temp:=LoadDatFile(id); + mem:=TMemoryStream.Create; + mem.Write(temp[0],Length(temp)); + hex.LoadFromStream(mem); + mem.Free; + Form5.ShowPreview(id); + lbl_zerobyte.Visible:=False; + hex.Visible:=True; + END ELSE BEGIN + lbl_fileinfo.Caption:= + 'Filename: '+dat_files[id].FileName; + lbl_zerobyte.Visible:=True; + hex.Visible:=False; + END; + END; + +PROCEDURE TForm1.FormCreate(Sender: TObject); + BEGIN + Form1.Caption:='Oni Un/Packer '+version; + Form1.FormResize(Form1); + + panel_all.Align:=alClient; + + IF FileExists(ExtractFilepath(Application.EXEname)+'\oniunpacker.ini') THEN BEGIN + AssignFile(AppSettingsFile,ExtractFilepath(Application.EXEname)+'\oniunpacker.ini'); + Reset(AppSettingsFile); + Read(AppSettingsFile,AppSettings); + CloseFile(AppSettingsFile); + END ELSE BEGIN + AppSettings.DatPath:='D:\Spiele\Oni\GameDataFolder'; + AppSettings.ExtractPath:='C:\Dokumente und Einstellungen\Administrator\Desktop'; + END; + END; + +PROCEDURE TForm1.btn_extractconvertClick(Sender: TObject); + BEGIN + Form1.menu_extractfileClick(Form1); + END; + +PROCEDURE TForm1.FormResize(Sender: TObject); + CONST + MinWidth:Integer=750; + MinHeight:Integer=500; + BEGIN + IF NOT group_progress.Visible THEN BEGIN + IF Form1.Width0 THEN Inc(errors); + IF (i MOD 25)=0 THEN BEGIN + lbl_progress.Caption:=IntToStr(i)+'/'+IntToStr(progress.Max); + progress.Position:=i; + Application.ProcessMessages; + IF btn_extractcancel.Caption='Cancel_' THEN BEGIN + btn_extractcancel.Caption:='Cancel'; + Break; + END; + END; + END; + IF errors>0 THEN + ShowMessage(IntToStr(errors)+' errors encountered.'); + + group_progress.Visible:=False; + Form1.Width:=oldwidth; + Form1.Height:=oldheight; + Form1.WindowState:=oldstate; + //FOR i:=0 TO menu.ComponentCount DO menu.Items.Items[i].Enabled:=True; + panel_all.Visible:=True; + END; + +PROCEDURE TForm1.menu_extractallClick(Sender: TObject); + VAR + i:LongWord; + errors:LongWord; + oldwidth,oldheight:Integer; + oldstate:TWindowState; + BEGIN + panel_all.Visible:=False; + group_progress.Visible:=True; + //FOR i:=0 TO menu.ComponentCount DO menu.Items.Items[i].Enabled:=False; + oldwidth:=Form1.Width; + oldheight:=Form1.Height; + oldstate:=Form1.WindowState; + Form1.WindowState:=wsNormal; + Form1.Width:=400; + Form1.Height:=120; + group_progress.Left:=0; + group_progress.Top:=0; + group_progress.Width:=Form1.Width-8; + progress.Width:=group_progress.Width-80; + progress.Max:=dat_header.files; + btn_extractcancel.Left:=group_progress.Width-65; + btn_extractcancel.Caption:='Cancel'; + btn_extractcancel.SetFocus; + + errors:=0; + FOR i:=0 TO High(dat_files) DO BEGIN + IF ExportFile(i,True)>0 THEN Inc(errors); + IF (i MOD 25)=0 THEN BEGIN + lbl_progress.Caption:=IntToStr(i)+'/'+IntToStr(dat_header.Files); + progress.Position:=i; + Application.ProcessMessages; + IF btn_extractcancel.Caption='Cancel_' THEN BEGIN + btn_extractcancel.Caption:='Cancel'; + Break; + END; + END; + END; + IF errors>0 THEN + ShowMessage(IntToStr(errors)+' errors encountered.'); + + group_progress.Visible:=False; + Form1.Width:=oldwidth; + Form1.Height:=oldheight; + Form1.WindowState:=oldstate; + //FOR i:=0 TO menu.ComponentCount DO menu.Items.Items[i].Enabled:=True; + panel_all.Visible:=True; + END; + +END. Index: /oup/releases/0.17a/Unit2_functions.pas =================================================================== --- /oup/releases/0.17a/Unit2_functions.pas (revision 21) +++ /oup/releases/0.17a/Unit2_functions.pas (revision 21) @@ -0,0 +1,255 @@ +UNIT Unit2_functions; +INTERFACE +USES Classes, SysUtils, StrUtils, Math, SQLiteTable3, Unit3_data, Unit4_Exporters; + +FUNCTION Decode_Int(buffer:Tdata):LongWord; +FUNCTION Encode_Int(input:LongWord):Tdata; +FUNCTION Decode_Float(buffer:Tdata):Single; +FUNCTION Encode_Float(input:Single):Tdata; +FUNCTION LoadDatInfos(filename:String):Boolean; +FUNCTION LoadDatFile(fileid:LongWord):Tdata; +PROCEDURE SaveDatFile(fileid:LongWord; data:Tdata); +FUNCTION LoadDatFilePart(fileid,offset,size:LongWord; target:Pointer):Boolean; +FUNCTION LoadRawFilePart(address,size:LongWord; target:Pointer):Boolean; +FUNCTION FormatNumber(value:LongWord; width:Byte; leadingzeros:Char):String; +FUNCTION FormatFileSize(size:LongWord):String; +FUNCTION CreateHexString(data:Tdata; HexOnly:Boolean):String; +FUNCTION ExportFile(fileid:LongWord; convert:Boolean):Integer; +FUNCTION GetWinFileName(fileid:LongWord; substring:String):String; +FUNCTION GetExtractPath:String; + + + +IMPLEMENTATION + +TYPE + TValueSwitcher=Record + CASE IsFloat: Boolean OF + True: (ValueFloat:Single); + False: (ValueInt:LongWord); + END; + + +FUNCTION Decode_Int(buffer:Tdata):LongWord; + BEGIN + Result:=buffer[0]+buffer[1]*256+buffer[2]*256*256+buffer[3]*256*256*256; + END; +FUNCTION Encode_Int(input:LongWord):Tdata; + BEGIN + Result[0]:=input MOD 256; + input:=input DIV 256; + Result[1]:=input MOD 256; + input:=input DIV 256; + Result[2]:=input MOD 256; + input:=input DIV 256; + Result[3]:=input MOD 256; + END; +FUNCTION Decode_Float(buffer:Tdata):Single; + VAR _valueswitcher:TValueSwitcher; + BEGIN + _valueswitcher.ValueInt:=Decode_Int(buffer); + Result:=_valueswitcher.ValueFloat; + END; +FUNCTION Encode_Float(input:Single):Tdata; + VAR _valueswitcher:TValueSwitcher; + BEGIN + _valueswitcher.ValueFloat:=input; + Result:=Encode_Int(_valueswitcher.ValueInt); + END; + + +FUNCTION LoadDatInfos(filename:String):Boolean; + VAR i:LongWord; + dat_file:TFileStream; + BEGIN + Result:=True; + dat_filename:=filename; + raw_filename:=MidStr(filename,1,Length(filename)-3)+'raw'; + dat_file:=TFileStream.Create(filename, fmOpenRead); + dat_file.Read(dat_header,SizeOf(dat_header)); + FOR i:=0 TO High(dat_header.Ident) DO + IF dat_header.Ident[i]<>header_ident1[i] THEN BEGIN + Result:=False; + Exit; + END; +{ FOR i:=0 TO High(dat_header.Ident2) DO + IF dat_header.Ident2[i]<>header_ident2[i] THEN BEGIN + Result:=False; + Exit; + END; +} + SetLength(dat_filesmap,dat_header.Files); + SetLength(dat_files,dat_header.Files); + FOR i:=0 TO dat_header.Files-1 DO dat_file.Read(dat_filesmap[i],SizeOf(dat_filesmap[i])); + FOR i:=0 TO dat_header.Files-1 DO BEGIN + dat_files[i].Extension:=dat_filesmap[i].Extension; + dat_files[i].Extension:=ReverseString(dat_files[i].Extension); + dat_files[i].Size:=dat_filesmap[i].FileSize; + dat_files[i].FileType:=dat_filesmap[i].FileType; + dat_files[i].DatAddr:=dat_filesmap[i].DataAddr-8+dat_header.DataAddr; + IF (dat_filesmap[i].FileType AND $01)=0 THEN BEGIN + dat_file.Seek(dat_filesmap[i].NameAddr+dat_header.NamesAddr,soFromBeginning); + SetLength(dat_files[i].Name,100); + dat_file.Read(dat_files[i].Name[1],100); + dat_files[i].Name:=MidStr(dat_files[i].Name,1+4,Pos(#0,dat_files[i].Name)-1-4); + END ELSE BEGIN + dat_files[i].Name:=''; + END; + dat_files[i].FileName:=FormatNumber(i,5,'0')+'-'+dat_files[i].Name+'.'+dat_files[i].Extension; + END; + dat_file.Seek($40+dat_header.Files*$14,soFromBeginning); + SetLength(dat_namedfilesmap,dat_header.NamedFiles); + FOR i:=0 TO dat_header.NamedFiles-1 DO dat_file.Read(dat_namedfilesmap[i],SizeOf(dat_namedfilesmap[i])); + + dat_file.Seek($40+dat_header.Files*$14+dat_header.NamedFiles*$8,soFromBeginning); + SetLength(dat_extensionsmap,dat_header.Extensions); + FOR i:=0 TO dat_header.Extensions-1 DO dat_file.Read(dat_extensionsmap[i],SizeOf(dat_extensionsmap[i])); + + dat_file.Free; + END; + + +FUNCTION LoadDatFile(fileid:LongWord):Tdata; + VAR dat_file:TFileStream; + BEGIN + dat_file:=TFileStream.Create(dat_filename, fmOpenRead); + dat_file.Seek(dat_files[fileid].DatAddr,soFromBeginning); + SetLength(Result,dat_files[fileid].Size); + dat_file.Read(Result[0],dat_files[fileid].Size); + dat_file.Free; + END; + + +PROCEDURE SaveDatFile(fileid:LongWord; data:Tdata); + VAR dat_file:TFileStream; + BEGIN + dat_file:=TFileStream.Create(dat_filename, fmOpenReadWrite); + dat_file.Seek(dat_files[fileid].DatAddr,soFromBeginning); + dat_file.Write(data[0],Length(data)); + dat_file.Free; + END; + + +FUNCTION LoadDatFilePart(fileid,offset,size:LongWord; target:Pointer):Boolean; + VAR dat_file:TFileStream; + BEGIN + dat_file:=TFileStream.Create(dat_filename, fmOpenRead); + Result:=True; + dat_file.Seek(dat_files[fileid].DatAddr+offset,soFromBeginning); + dat_file.Read(target^,size); + dat_file.Free; + END; + + +FUNCTION LoadRawFilePart(address,size:LongWord; target:Pointer):Boolean; + VAR + filestream:TFileStream; + BEGIN + Result:=True; + filestream:=TFileStream.Create(AnsiReplaceStr(dat_filename,'.dat','.raw'),fmOpenRead); + filestream.Seek(address,soFromBeginning); + filestream.Read(target^,size); + filestream.Free; + END; + + +FUNCTION FormatNumber(value:LongWord; width:Byte; leadingzeros:Char):String; + BEGIN + Result:=AnsiReplaceStr(Format('%'+IntToStr(width)+'u',[value]),' ',leadingzeros); + END; + + +FUNCTION FormatFileSize(size:LongWord):String; + BEGIN + IF size>=1024*1024*1024 THEN BEGIN + Result:=FloatToStrF(size/1024/1024/1024,ffFixed,5,1)+' GB'; + END ELSE BEGIN + IF size>=1024*1024 THEN BEGIN + Result:=FloatToStrF(size/1024/1024,ffFixed,5,1)+' MB'; + END ELSE BEGIN + IF size>=1024 THEN BEGIN + Result:=FloatToStrF(size/1024,ffFixed,5,1)+' KB'; + END ELSE BEGIN + Result:=IntToStr(size)+' B'; + END; + END; + END; + END; + + +FUNCTION CreateHexString(data:Tdata; HexOnly:Boolean):String; + VAR + string_build,ascii_version:String; + i:LongWord; + BEGIN + string_build:=''; + ascii_version:=''; + FOR i:=0 TO High(data) DO BEGIN + IF NOT HexOnly THEN + IF (i MOD 16)=0 THEN + string_build:=string_build+'0x'+IntToHex(i,6)+' '; + string_build:=string_build+IntToHex(data[i],2); + IF NOT HexOnly THEN BEGIN + IF data[i]>=32 THEN ascii_version:=ascii_version+Chr(data[i]) + ELSE ascii_version:=ascii_version+'.'; + IF ((i+1) MOD 2)=0 THEN string_build:=string_build+#32; + IF ((i+1) MOD 16)=0 THEN BEGIN + string_build:=string_build+#32+ascii_version+CrLf; + ascii_version:=''; + END; + END; + END; + Result:=string_build; + END; + + +FUNCTION ExportFile(fileid:LongWord; convert:Boolean):Integer; + VAR + i:Byte; + BEGIN + Result:=export_noerror; + + //ExportDefFileHeader(fileid); + + IF (dat_files[fileid].FileType AND $02)=0 THEN BEGIN + //ExportDatFile(fileid); + + FOR i:=1 TO Length(ExportHandlers)+1 DO BEGIN + IF i<=Length(ExportHandlers) THEN BEGIN + IF ExportHandlers[i].Ext=dat_files[fileid].Extension THEN BEGIN + IF ExportHandlers[i].needed THEN BEGIN + CASE ExportHandlers[i].Handler(fileid,convert) OF + 0: Result:=0; + ELSE + Result:=export_handlererror; + END; + END; + Break; + END; + END ELSE BEGIN + Result:=export_nohandler; + END; + END; + END; + END; + + +FUNCTION GetWinFileName(fileid:LongWord; substring:String):String; + VAR + name:String; + BEGIN + name:=dat_files[fileid].Name; + name:=AnsiReplaceStr(name,'\','__'); + name:=AnsiReplaceStr(name,'/','__'); + name:=AnsiReplaceStr(name,'>','__'); + name:=AnsiReplaceStr(name,'<','__'); + Result:=FormatNumber(fileid,5,'0')+'-'+name+'.'+substring+'.'+dat_files[fileid].Extension; + END; + +FUNCTION GetExtractPath:String; + BEGIN + Result:=ExtractFilePath(dat_filename)+'\extracted_'+ExtractFileName(dat_filename); + END; + + +END. Index: /oup/releases/0.17a/Unit3_data.pas =================================================================== --- /oup/releases/0.17a/Unit3_data.pas (revision 21) +++ /oup/releases/0.17a/Unit3_data.pas (revision 21) @@ -0,0 +1,84 @@ +UNIT Unit3_data; +INTERFACE +USES Classes; + +CONST + version:String='v0.17a'; + CrLf:String[2]=#13+#10; + +TYPE + Tdata=Array OF Byte; + Theader=PACKED RECORD + Ident:Array[0..$13] OF Byte; + Files:LongWord; + NamedFiles:LongWord; + Extensions:LongWord; + DataAddr:LongWord; + DataSize:LongWord; + NamesAddr:LongWord; + NamesSize:LongWord; + Ident2:Array[0..$F] OF Byte; + END; + Tfilesmap=Array OF PACKED RECORD + Extension:Array[0..$3] OF Char; + DataAddr:LongWord; + NameAddr:LongWord; + FileSize:LongWord; + FileType:LongWord; + END; + Tfiles=Array OF PACKED RECORD + FileName:String; + Extension:String[4]; + Name:String; + Size:LongWord; + FileType:LongWord; + DatAddr:LongWord; + END; + + Tnamedfilesmap=Array OF PACKED RECORD + FileNumber:LongWord; + blubb:LongWord; + END; + Textensionsmap=Array OF PACKED RECORD + Ident:Array[0..$7] OF Byte; + Extension:Array[0..$3] OF Char; + ExtCount:LongWord; + END; + + TAppSettings=RECORD + DatPath:String[250]; + ExtractPath:String[250]; + END; + + TExportHandlers=RECORD + Ext:String[4]; + needed:Boolean; + Handler:Function(fileid:LongWord; convert:Boolean):Integer; + END; + +VAR + dat_filename:String=''; + raw_filename:String=''; + dat_header:Theader; + dat_filesmap:Tfilesmap; + dat_files:Tfiles; + dat_namedfilesmap:Tnamedfilesmap; + dat_extensionsmap:Textensionsmap; + AppSettings:TAppSettings; + AppSettingsFile:File OF TAppSettings; + +CONST + header_ident1:Array[0..$13] OF Byte= + ($1F,$27,$DC,$33,$DF,$BC,$03,$00,$31,$33,$52,$56,$40,$00,$14,$00,$10,$00,$08,$00); + header_ident2:Array[0..$F] OF Byte= + ($99,$CF,$40,$00,$90,$4F,$63,$00,$F4,$55,$5F,$00,$90,$4F,$63,$00); + + export_noerror:Integer=0; + export_nohandler:Integer=1; + export_handlererror:Integer=2; + export_error:Integer=3; + +IMPLEMENTATION + +END. + Index: /oup/releases/0.17a/Unit4_Exporters.pas =================================================================== --- /oup/releases/0.17a/Unit4_Exporters.pas (revision 21) +++ /oup/releases/0.17a/Unit4_Exporters.pas (revision 21) @@ -0,0 +1,181 @@ +UNIT Unit4_Exporters; +INTERFACE +USES Classes, StrUtils, SysUtils, Math, Unit3_data, Unit6_imgfuncs; + +PROCEDURE ExportDefLine(fileid:LongWord; line:String; create:Boolean); +PROCEDURE ExportDefFileHeader(fileid:LongWord); +PROCEDURE ExportDatFile(fileid:LongWord); + +FUNCTION ExportTRAC(fileid:LongWord; convert:Boolean):Integer; +FUNCTION ExportTXAN(fileid:LongWord; convert:Boolean):Integer; +FUNCTION ExportTXMB(fileid:LongWord; convert:Boolean):Integer; +FUNCTION ExportTXMP(fileid:LongWord; convert:Boolean):Integer; +VAR + ExportHandlers:Array[1..5] OF TExportHandlers=( + (Ext:'ABNA'; needed:False), + //(Ext:'AGDB'; needed:False), + (Ext:'TRAC'; needed:True; Handler:ExportTRAC), + (Ext:'TXAN'; needed:True; Handler:ExportTXAN), + (Ext:'TXMB'; needed:True; Handler:ExportTXMB), + (Ext:'TXMP'; needed:True; Handler:ExportTXMP) + ); + + + +IMPLEMENTATION +USES Unit2_functions; + +PROCEDURE ExportDefLine(fileid:LongWord; line:String; create:Boolean); + VAR + filestream:TFileStream; + data:Tdata; + i:LongWord; + BEGIN + SetLength(data,Length(line)+2); + FOR i:=1 TO Length(line) DO + data[i-1]:=Ord(line[i]); + data[Length(line)]:=13; + data[Length(line)+1]:=10; + { + IF create THEN + filestream:=TFileStream.Create(GetExtractPath+'\'+GetWinFileName(fileid,'_DEF_'),fmCreate) + ELSE BEGIN + filestream:=TFileStream.Create(GetExtractPath+'\'+GetWinFileName(fileid,'_DEF_'),fmOpenWrite); + filestream.Seek(0,soFromEnd); + END; + filestream.Write(data[0],Length(data)); + filestream.Free; + } + END; + +PROCEDURE ExportDefFileHeader(fileid:LongWord); + BEGIN + IF NOT DirectoryExists(GetExtractPath) THEN + CreateDir(GetExtractPath); + WITH dat_files[fileid] DO + ExportDefLine(fileid,FormatNumber(fileid,5,'0')+':'+Name+':'+Extension+':'+IntToHex(Size,8)+':'+IntToHex(FileType,8),True); + END; + +PROCEDURE ExportDatFile(fileid:LongWord); + VAR + filestream:TFileStream; + data:Tdata; + BEGIN + data:=LoadDatFile(fileid); + filestream:=TFileStream.Create(GetExtractPath+'\'+GetWinFileName(fileid,'_DAT_'),fmCreate); + filestream.Write(data[0],Length(data)); + filestream.Free; + END; + + +FUNCTION ExportTRAC; + VAR + link:LongWord; + linkcount:Word; + i:LongWord; + BEGIN + Result:=export_noerror; + + LoadDatFilePart(fileid,$18,SizeOf(link),@link); + link:=link DIV 256; + ExportDefLine(fileid,FormatNumber(0,4,'0')+':LINKtoTRAC:'+FormatNumber(link,5,'0')+':'+dat_files[link].Name+':'+dat_files[link].Extension,False); + + LoadDatFilePart(fileid,$1E,SizeOf(linkcount),@linkcount); + ExportDefLine(fileid,'TRAMLINKS:'+FormatNumber(linkcount,4,'0'),False); + FOR i:=1 TO linkcount DO BEGIN + LoadDatFilePart(fileid,$20+(i-1)*12+8,SizeOf(link),@link); + link:=link DIV 256; + ExportDefLine(fileid,FormatNumber(i,4,'0')+':LINKtoTRAM:'+FormatNumber(link,5,'0')+':'+dat_files[link].Name+':'+dat_files[link].Extension,False); + END; + END; + +FUNCTION ExportTXAN; + VAR + loop_speed,unknown:Word; + linkcount:LongWord; + link:LongWord; + i:Byte; + BEGIN + Result:=export_noerror; + + LoadDatFilePart(fileid,$14,SizeOf(loop_speed),@loop_speed); + LoadDatFilePart(fileid,$16,SizeOf(unknown),@unknown); + ExportDefLine(fileid,'LOOPSPEED:'+FormatNumber(loop_speed,2,'0'),False); + ExportDefLine(fileid,'UNKNOWN:'+FormatNumber(unknown,2,'0'),False); + + LoadDatFilePart(fileid,$1C,SizeOf(linkcount),@linkcount); + ExportDefLine(fileid,'TXMPLINKS:'+FormatNumber(linkcount,4,'0'),False); + FOR i:=0 TO linkcount-1 DO BEGIN + LoadDatFilePart(fileid,$20+i*4,SizeOf(link),@link); + link:=link DIV 256; + IF link=0 THEN link:=fileid-1; + ExportDefLine(fileid,FormatNumber(i,4,'0')+':LINKtoTXMP:'+FormatNumber(link,5,'0')+':'+dat_files[link].Name+':'+dat_files[link].Extension,False); + END; + END; + +FUNCTION ExportTXMB; + VAR + filestream:TFileStream; + subfile:Byte; + linkcount:LongWord; + link:LongWord; + width,height:Word; + cols,rows:Word; + i:Byte; + img:TImgPackage; + data:Tdata; + BEGIN + Result:=export_noerror; + subfile:=1; + + LoadDatFilePart(fileid,$10,SizeOf(width),@width); + LoadDatFilePart(fileid,$12,SizeOf(height),@height); + LoadDatFilePart(fileid,$18,SizeOf(cols),@cols); + LoadDatFilePart(fileid,$1A,SizeOf(rows),@rows); + ExportDefLine(fileid,'WIDTH:'+FormatNumber(width,4,'0'),False); + ExportDefLine(fileid,'HEIGHT:'+FormatNumber(height,4,'0'),False); + ExportDefLine(fileid,'COLS:'+FormatNumber(cols,2,'0'),False); + ExportDefLine(fileid,'ROWS:'+FormatNumber(rows,2,'0'),False); + + LoadDatFilePart(fileid,$1C,SizeOf(linkcount),@linkcount); + ExportDefLine(fileid,'TXMPLINKS:'+FormatNumber(linkcount,4,'0'),False); + FOR i:=0 TO linkcount-1 DO BEGIN + LoadDatFilePart(fileid,$20+i*4,SizeOf(link),@link); + link:=link DIV 256; + IF link=0 THEN link:=fileid-1; + ExportDefLine(fileid,FormatNumber(i,4,'0')+':LINKtoTXMP:'+FormatNumber(link,5,'0')+':'+dat_files[link].Name+':'+dat_files[link].Extension,False); + END; + + IF convert THEN BEGIN + img:=LoadTXMBconnected(fileid); + data:=ImgdataToBmp(img.imgx,img.imgy,img.imgdepth,img.storetype,img.imgdata); + filestream:=TFileStream.Create(GetExtractPath+'\'+GetWinFileName(fileid,FormatNumber(subfile,2,'0')+'-ImgData')+'.bmp',fmCreate); + filestream.Write(data[0],Length(data)); + filestream.Free; + END; + END; + +FUNCTION ExportTXMP; + VAR + filestream:TFileStream; + subfile:Byte; + img:TImgPackage; + BEGIN + Result:=export_noerror; + subfile:=1; + + img:=LoadImgData(fileid); + { + filestream:=TFileStream.Create(GetExtractPath+'\'+GetWinFileName(fileid,FormatNumber(subfile,2,'0')+'-ImgData'),fmCreate); + filestream.Write(img.imgdata[0],Length(img.imgdata)); + filestream.Free; + } + IF convert THEN BEGIN + img.imgdata:=ImgdataToBMP(img.imgx,img.imgy,img.imgdepth,img.storetype,img.imgdata); + filestream:=TFileStream.Create(GetExtractPath+'\'+GetWinFileName(fileid,FormatNumber(subfile,2,'0')+'-ImgData')+'.bmp',fmCreate); + filestream.Write(img.imgdata[0],Length(img.imgdata)); + filestream.Free; + END; + END; + +END. Index: /oup/releases/0.17a/Unit5_preview.dfm =================================================================== --- /oup/releases/0.17a/Unit5_preview.dfm (revision 21) +++ /oup/releases/0.17a/Unit5_preview.dfm (revision 21) @@ -0,0 +1,74 @@ +object Form5: TForm5 + Left = 0 + Top = 0 + Width = 435 + Height = 348 + BorderStyle = bsSizeToolWin + Caption = 'Preview' + Color = clBtnFace + Font.Charset = DEFAULT_CHARSET + Font.Color = clWindowText + Font.Height = -11 + Font.Name = 'Tahoma' + Font.Style = [] + FormStyle = fsStayOnTop + OldCreateOrder = False + OnCloseQuery = FormCloseQuery + OnCreate = FormCreate + OnResize = FormResize + PixelsPerInch = 96 + TextHeight = 13 + object img: TImage + Left = 0 + Top = 20 + Width = 427 + Height = 304 + Align = alClient + end + object panel_buttons: TPanel + Left = 0 + Top = 0 + Width = 427 + Height = 20 + Align = alTop + BevelOuter = bvNone + TabOrder = 0 + Visible = False + OnResize = panel_buttonsResize + object btn_dec: TButton + Left = 0 + Top = 0 + Width = 20 + Height = 20 + Caption = '-' + Enabled = False + TabOrder = 0 + OnClick = btn_decClick + end + object btn_startstop: TButton + Left = 21 + Top = 0 + Width = 80 + Height = 20 + Caption = 'Stop automatic' + TabOrder = 1 + OnClick = btn_startstopClick + end + object btn_inc: TButton + Left = 102 + Top = 0 + Width = 20 + Height = 20 + Caption = '+' + Enabled = False + TabOrder = 2 + OnClick = btn_incClick + end + end + object timer: TTimer + Enabled = False + OnTimer = timerTimer + Left = 72 + Top = 48 + end +end Index: /oup/releases/0.17a/Unit5_preview.pas =================================================================== --- /oup/releases/0.17a/Unit5_preview.pas (revision 21) +++ /oup/releases/0.17a/Unit5_preview.pas (revision 21) @@ -0,0 +1,183 @@ +UNIT Unit5_preview; +INTERFACE +USES + Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, + Dialogs, Math, ExtCtrls, Unit2_functions, Unit3_data, Unit4_exporters, Unit6_imgfuncs, + StdCtrls; + +TYPE + TForm5 = Class(TForm) + img: TImage; + timer: TTimer; + panel_buttons: TPanel; + btn_dec: TButton; + btn_startstop: TButton; + btn_inc: TButton; + PROCEDURE btn_incClick(Sender: TObject); + PROCEDURE btn_decClick(Sender: TObject); + PROCEDURE FormResize(Sender: TObject); + PROCEDURE btn_startstopClick(Sender: TObject); + PROCEDURE panel_buttonsResize(Sender: TObject); + PROCEDURE timerTimer(Sender: TObject); + PROCEDURE FormCreate(Sender: TObject); + PROCEDURE FormCloseQuery(Sender: TObject; var CanClose: Boolean); + PROCEDURE ShowPreview(fileid:LongWord); + PRIVATE + PUBLIC + END; + +VAR + Form5: TForm5; + +IMPLEMENTATION +{$R *.dfm} +USES Unit1_main; +VAR + memstreams:Array OF TMemoryStream; + actualimg:Byte; + _fileid:LongWord; + +PROCEDURE PreviewTXMB; + VAR + data:Tdata; + img:TImgPackage; + BEGIN + SetLength(memstreams,1); + img:=LoadTXMBconnected(_fileid); + data:=ImgdataToBmp(img.imgx,img.imgy,img.imgdepth,img.storetype,img.imgdata); + + memstreams[0].Clear; + memstreams[0].Write(data[0],Length(data)); + memstreams[0].Seek(0,soFromBeginning); + + Form5.img.Picture.Bitmap.LoadFromStream(memstreams[0]); + END; + +PROCEDURE PreviewTXMP; + VAR + data:Tdata; + img:TImgPackage; + BEGIN + SetLength(memstreams,1); + img:=LoadImgData(_fileid); + data:=ImgdataToBmp(img.imgx,img.imgy,img.imgdepth,img.storetype,img.imgdata); + + memstreams[0].Clear; + memstreams[0].Write(data[0],Length(data)); + memstreams[0].Seek(0,soFromBeginning); + + Form5.img.Picture.Bitmap.LoadFromStream(memstreams[0]); + END; + +PROCEDURE PreviewTXAN; + VAR + loop_speed:Word; + linkcount:LongWord; + link:LongWord; + i:Byte; + data:Tdata; + img:TImgPackage; + BEGIN + LoadDatFilePart(_fileid,$14,SizeOf(loop_speed),@loop_speed); + LoadDatFilePart(_fileid,$1C,SizeOf(linkcount),@linkcount); + SetLength(memstreams,linkcount); + FOR i:=0 TO linkcount-1 DO BEGIN + LoadDatFilePart(_fileid,$20+i*4,SizeOf(link),@link); + link:=link DIV 256; + IF link=0 THEN link:=_fileid-1; + memstreams[i]:=TMemoryStream.Create; + img:=LoadImgData(link); + data:=ImgdataToBmp(img.imgx,img.imgy,img.imgdepth,img.storetype,img.imgdata); + memstreams[i].Clear; + memstreams[i].Write(data[0],Length(data)); + memstreams[i].Seek(0,soFromBeginning); + END; + actualimg:=254; + Form5.timer.Interval:=Floor(loop_speed*(1/60)*1000); + Form5.timer.Enabled:=False; + Form5.btn_startstopClick(Form5); + Form5.panel_buttons.Visible:=True; + END; + +PROCEDURE TForm5.ShowPreview(fileid:LongWord); + BEGIN + _fileid:=fileid; + Form5.timer.Enabled:=False; + Form5.panel_buttons.Visible:=False; + Form5.Caption:='Preview '+dat_files[_fileid].FileName; + IF dat_files[fileid].Extension='TXAN' THEN PreviewTXAN; + IF dat_files[fileid].Extension='TXMB' THEN PreviewTXMB; + IF dat_files[fileid].Extension='TXMP' THEN PreviewTXMP; + END; + +PROCEDURE TForm5.FormCloseQuery(Sender: TObject; var CanClose: Boolean); + BEGIN + CanClose:=False; + Form5.Visible:=False; + END; + +PROCEDURE TForm5.FormCreate(Sender: TObject); + BEGIN + SetLength(memstreams,1); + memstreams[0]:=TMemoryStream.Create; + Form5.Width:=260; + Form5.Height:=300; + END; + +PROCEDURE TForm5.timerTimer(Sender: TObject); + BEGIN + Inc(actualimg); + IF actualimg>=Length(memstreams) THEN actualimg:=0; + Form5.img.Picture.Bitmap.LoadFromStream(memstreams[actualimg]); + memstreams[actualimg].Seek(0,soFromBeginning); + Form5.Caption:='Preview '+dat_files[_fileid].FileName+' ('+IntToStr(actualimg+1)+'/'+IntToStr(Length(memstreams))+')'; + END; + +PROCEDURE TForm5.panel_buttonsResize(Sender: TObject); + BEGIN + btn_startstop.Width:=panel_buttons.Width-45; + btn_inc.Left:=panel_buttons.Width-23; + END; + +PROCEDURE TForm5.btn_startstopClick(Sender: TObject); + BEGIN + Form5.timer.Enabled:=NOT Form5.timer.Enabled; + Form5.btn_dec.Enabled:=NOT Form5.timer.Enabled; + Form5.btn_inc.Enabled:=NOT Form5.timer.Enabled; + IF Form5.timer.Enabled THEN + Form5.btn_startstop.Caption:='Stop automatic' + ELSE + Form5.btn_startstop.Caption:='Start automatic'; + END; + +PROCEDURE TForm5.FormResize(Sender: TObject); + BEGIN + IF Form5.Width>=150 THEN BEGIN + END ELSE Form5.Width:=150; + IF Form5.Height>=150 THEN BEGIN + END ELSE Form5.Height:=150; + END; + +PROCEDURE TForm5.btn_decClick(Sender: TObject); + BEGIN + IF actualimg>0 THEN + Dec(actualimg) + ELSE + actualimg:=High(memstreams); + Form5.Caption:='Preview '+dat_files[_fileid].FileName+' ('+IntToStr(actualimg+1)+'/'+IntToStr(Length(memstreams))+')'; + Form5.img.Picture.Bitmap.LoadFromStream(memstreams[actualimg]); + memstreams[actualimg].Seek(0,soFromBeginning); + END; + +PROCEDURE TForm5.btn_incClick(Sender: TObject); + BEGIN + IF actualimg0) THEN BEGIN + Inc(row_orig); + IF (row_orig MOD 2)=0 THEN BEGIN + Inc(row); + col:=0; + END; + END; + IF (row_orig MOD 2)=0 THEN BEGIN + IF (i MOD 2)=0 THEN BEGIN + FOR j:=0 TO (imgdepth DIV 8)-1 DO + temparray[((row*(oldx DIV 2))+col)*(imgdepth DIV 8)+j]:=data[i*2+j]; + Inc(col); + END; + END; + END; + Result:=temparray; + END; + + +FUNCTION RevertImage(imgx,imgy,imgdepth:LongWord; imgdata:Tdata):Tdata; + VAR + x,y,i:LongWord; + BEGIN + SetLength(Result,imgx*imgy*(imgdepth DIV 8)); + FOR y:=0 TO imgy-1 DO + FOR x:=0 TO imgx-1 DO + FOR i:=0 TO (imgdepth DIV 8)-1 DO + Result[((imgx*(imgy-1-y)+x)*(imgdepth DIV 8))+i]:= + imgdata[(imgx*y+x)*(imgdepth DIV 8)+i]; + END; + + +FUNCTION DecompressImage(imgx,imgy:LongWord; imgdata:Tdata):Tdata; + TYPE + Tcolor=RECORD + RGBb:Byte; + RGBg:Byte; + RGBr:Byte; + RGBa:Byte; + END; + VAR + i,j,x,y:LongWord; + color:Array[1..4] OF Tcolor; + pixel:Array[1..16] OF Byte; + BEGIN + x:=0; + y:=0; + SetLength(Result,imgx*imgy*4); + FOR i:=0 TO ((imgx*imgy) DIV 16)-1 DO BEGIN + Color[1].RGBb:=Floor(((imgdata[(i*8)+0]+imgdata[(i*8)+1]*256) AND $001F) / $001F * 255); + Color[1].RGBg:=Floor(((imgdata[(i*8)+0]+imgdata[(i*8)+1]*256) AND $07E0) / $07E0 * 255); + Color[1].RGBr:=Floor(((imgdata[(i*8)+0]+imgdata[(i*8)+1]*256) AND $F800) / $F800 * 255); + Color[1].RGBa:=255; + Color[2].RGBb:=Floor(((imgdata[(i*8)+2]+imgdata[(i*8)+3]*256) AND $001F) / $001F * 255); + Color[2].RGBg:=Floor(((imgdata[(i*8)+2]+imgdata[(i*8)+3]*256) AND $07E0) / $07E0 * 255); + Color[2].RGBr:=Floor(((imgdata[(i*8)+2]+imgdata[(i*8)+3]*256) AND $F800) / $F800 * 255); + Color[2].RGBa:=255; + Color[3].RGBb:=Floor( Color[1].RGBb/3*2 + Color[2].RGBb/3 ); + Color[3].RGBg:=Floor( Color[1].RGBg/3*2 + Color[2].RGBg/3 ); + Color[3].RGBr:=Floor( Color[1].RGBr/3*2 + Color[2].RGBr/3 ); + Color[3].RGBa:=255; + Color[4].RGBb:=Floor( Color[1].RGBb/3 + Color[2].RGBb/3*2 ); + Color[4].RGBg:=Floor( Color[1].RGBg/3 + Color[2].RGBg/3*2 ); + Color[4].RGBr:=Floor( Color[1].RGBr/3 + Color[2].RGBr/3*2 ); + Color[4].RGBa:=255; + Pixel[1]:=Floor( (imgdata[(i*8)+4] AND $C0) / $40 + 1 ); + Pixel[2]:=Floor( (imgdata[(i*8)+4] AND $30) / $10 + 1 ); + Pixel[3]:=Floor( (imgdata[(i*8)+4] AND $0C) / $04 + 1 ); + Pixel[4]:=Floor( (imgdata[(i*8)+4] AND $03) + 1 ); + Pixel[5]:=Floor( (imgdata[(i*8)+5] AND $C0) / $40 + 1 ); + Pixel[6]:=Floor( (imgdata[(i*8)+5] AND $30) / $10 + 1 ); + Pixel[7]:=Floor( (imgdata[(i*8)+5] AND $0C) / $04 + 1 ); + Pixel[8]:=Floor( (imgdata[(i*8)+5] AND $03) + 1 ); + Pixel[9]:=Floor( (imgdata[(i*8)+6] AND $C0) / $40 + 1 ); + Pixel[10]:=Floor( (imgdata[(i*8)+6] AND $30) / $10 + 1 ); + Pixel[11]:=Floor( (imgdata[(i*8)+6] AND $0C) / $04 + 1 ); + Pixel[12]:=Floor( (imgdata[(i*8)+6] AND $03) + 1 ); + Pixel[13]:=Floor( (imgdata[(i*8)+7] AND $C0) / $40 + 1 ); + Pixel[14]:=Floor( (imgdata[(i*8)+7] AND $30) / $10 + 1 ); + Pixel[15]:=Floor( (imgdata[(i*8)+7] AND $0C) / $04 + 1 ); + Pixel[16]:=Floor( (imgdata[(i*8)+7] AND $03) + 1 ); + FOR j:=0 TO 3 DO BEGIN + Result[((y+3)*imgx+x+j)*3+0]:=Color[Pixel[16-j]].RGBb; + Result[((y+3)*imgx+x+j)*3+1]:=Color[Pixel[16-j]].RGBg; + Result[((y+3)*imgx+x+j)*3+2]:=Color[Pixel[16-j]].RGBr; + END; + FOR j:=0 TO 3 DO BEGIN + Result[((y+2)*imgx+x+j)*3+0]:=Color[Pixel[12-j]].RGBb; + Result[((y+2)*imgx+x+j)*3+1]:=Color[Pixel[12-j]].RGBg; + Result[((y+2)*imgx+x+j)*3+2]:=Color[Pixel[12-j]].RGBr; + END; + FOR j:=0 TO 3 DO BEGIN + Result[((y+1)*imgx+x+j)*3+0]:=Color[Pixel[8-j]].RGBb; + Result[((y+1)*imgx+x+j)*3+1]:=Color[Pixel[8-j]].RGBg; + Result[((y+1)*imgx+x+j)*3+2]:=Color[Pixel[8-j]].RGBr; + END; + FOR j:=0 TO 3 DO BEGIN + Result[((y+0)*imgx+x+j)*3+0]:=Color[Pixel[4-j]].RGBb; + Result[((y+0)*imgx+x+j)*3+1]:=Color[Pixel[4-j]].RGBg; + Result[((y+0)*imgx+x+j)*3+2]:=Color[Pixel[4-j]].RGBr; + END; + x:=x+4; + IF x=imgx THEN BEGIN + y:=y+4; + x:=0; + END; + END; + END; + + +FUNCTION ImgdataToBmp(imgx,imgy,imgdepth,storetype:LongWord; imgdata:Tdata):Tdata; + CONST BMPheader:Array[0..53] OF Byte= + ($42,$4D,0,0,0,0,0,0,0,0,54,0,0,0, + 40,0,0,0,0,0,0,0,0,0,0,0,1,0,$18,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0); + VAR + i,x,y:LongWord; + BEGIN + CASE storetype OF + 0: BEGIN + SetLength(Result,imgx*imgy*3); + FOR y:=0 TO imgy-1 DO BEGIN + FOR x:=0 TO imgx-1 DO BEGIN + Result[((imgx*y+x)*3)+0]:=Floor( ( (imgdata[(imgx*y+x)*2]+imgdata[(imgx*y+x)*2+1]*256) AND $000F ) / $000F * 255); + Result[((imgx*y+x)*3)+1]:=Floor( ( (imgdata[(imgx*y+x)*2]+imgdata[(imgx*y+x)*2+1]*256) AND $00F0 ) / $00F0 * 255); + Result[((imgx*y+x)*3)+2]:=Floor( ( (imgdata[(imgx*y+x)*2]+imgdata[(imgx*y+x)*2+1]*256) AND $0F00 ) / $0F00 * 255); + END; + END; + END; + 1,2: BEGIN + SetLength(Result,imgx*imgy*3); + FOR y:=0 TO imgy-1 DO BEGIN + FOR x:=0 TO imgx-1 DO BEGIN + Result[((imgx*y+x)*3)+0]:=Floor( ( (imgdata[(imgx*y+x)*2]+imgdata[(imgx*y+x)*2+1]*256) AND $001F ) / $001F * 255); + Result[((imgx*y+x)*3)+1]:=Floor( ( (imgdata[(imgx*y+x)*2]+imgdata[(imgx*y+x)*2+1]*256) AND $03E0 ) / $03E0 * 255); + Result[((imgx*y+x)*3)+2]:=Floor( ( (imgdata[(imgx*y+x)*2]+imgdata[(imgx*y+x)*2+1]*256) AND $7C00 ) / $7C00 * 255); + END; + END; + END; + 8: BEGIN + SetLength(Result,imgx*imgy*3); + FOR y:=0 TO imgy-1 DO BEGIN + FOR x:=0 TO imgx-1 DO BEGIN + Result[((imgx*y+x)*3)+0]:=imgdata[(imgx*y+x)*4+0]; + Result[((imgx*y+x)*3)+1]:=imgdata[(imgx*y+x)*4+1]; + Result[((imgx*y+x)*3)+2]:=imgdata[(imgx*y+x)*4+2]; + END; + END; + END; + 9: BEGIN + Result:=DecompressImage(imgx,imgy,imgdata); + END; + END; + Result:=RevertImage(imgx,imgy,24,Result); + SetLength(Result,imgx*imgy*3+54); + FOR i:=High(Result)-54 DOWNTO 0 DO Result[i+54]:=Result[i]; + + FOR i:=0 TO High(BMPheader) DO Result[i]:=BMPheader[i]; + Result[2]:=((imgx*imgy*3+54) AND $000000FF); + Result[3]:=((imgx*imgy*3+54) AND $0000FF00) DIV $100; + Result[4]:=((imgx*imgy*3+54) AND $00FF0000) DIV $10000; + Result[5]:=((imgx*imgy*3+54) AND $FF000000) DIV $1000000; + Result[18]:=(imgx AND $000000FF) DIV $1; + Result[19]:=(imgx AND $0000FF00) DIV $100; + Result[20]:=(imgx AND $00FF0000) DIV $10000; + Result[21]:=(imgx AND $FF000000) DIV $1000000; + Result[22]:=(imgy AND $000000FF) DIV $1; + Result[23]:=(imgy AND $0000FF00) DIV $100; + Result[24]:=(imgy AND $00FF0000) DIV $10000; + Result[25]:=(imgy AND $FF000000) DIV $1000000; + Result[34]:=((imgx*imgy*3) AND $000000FF) DIV $1; + Result[35]:=((imgx*imgy*3) AND $0000FF00) DIV $100; + Result[36]:=((imgx*imgy*3) AND $00FF0000) DIV $10000; + Result[37]:=((imgx*imgy*3) AND $FF000000) DIV $1000000; + END; + +FUNCTION BmpToImgdata(bmpdata:Tdata; _32bit:Boolean):TImgPackage; + VAR + x,y:LongWord; + r24,g24,b24:Word; + r16,g16,b16:Word; + gesamt:Word; + BEGIN + Result.imgdepth:=0; + IF NOT((bmpdata[00]=$42) AND (bmpdata[01]=$4D)) THEN BEGIN + ShowMessage('Not a standard 24bit bitmap'); + Exit; + END; + IF NOT(bmpdata[10]=54) THEN BEGIN + ShowMessage('Imagedata has to start at 0x54'); + Exit; + END; + IF NOT(bmpdata[14]=40) THEN BEGIN + ShowMessage('Second bitmap header has to have 40 bytes'); + Exit; + END; + IF NOT(bmpdata[28]=24) THEN BEGIN + ShowMessage('Bitmap has to have 24bits'); + Exit; + END; + IF NOT(bmpdata[30]=0) THEN BEGIN + ShowMessage('Bitmap has to be uncompressed'); + Exit; + END; + Result.imgx:=bmpdata[18]+bmpdata[19]*256+bmpdata[20]*256*256+bmpdata[21]*256*256*256; + Result.imgy:=bmpdata[22]+bmpdata[23]*256+bmpdata[24]*256*256+bmpdata[25]*256*256*256; + IF _32bit THEN BEGIN + Result.imgdepth:=32; + Result.storetype:=8; + END ELSE BEGIN + Result.imgdepth:=16; + Result.storetype:=1; + END; + + SetLength(Result.imgdata,Result.imgx*Result.imgy*Result.imgdepth DIV 8); + IF _32bit THEN BEGIN + FOR y:=0 TO Result.imgy-1 DO BEGIN + FOR x:=0 TO Result.imgx-1 DO BEGIN + Result.imgdata[((Result.imgx*y+x)*4)+0]:=bmpdata[54+(Result.imgx*y+x)*3+0]; + Result.imgdata[((Result.imgx*y+x)*4)+1]:=bmpdata[54+(Result.imgx*y+x)*3+1]; + Result.imgdata[((Result.imgx*y+x)*4)+2]:=bmpdata[54+(Result.imgx*y+x)*3+2]; + Result.imgdata[((Result.imgx*y+x)*4)+3]:=0; + END; + END; + END ELSE BEGIN + FOR y:=0 TO Result.imgy-1 DO BEGIN + FOR x:=0 TO Result.imgx-1 DO BEGIN + r24:=bmpdata[54+(Result.imgx*y+x)*3+0]; + g24:=bmpdata[54+(Result.imgx*y+x)*3+1]; + b24:=bmpdata[54+(Result.imgx*y+x)*3+2]; + r16:=(Ceil(r24*$001F/255)) AND $001F; + g16:=(Ceil(g24*$03E0/255)) AND $03E0; + b16:=(Ceil(b24*$7C00/255)) AND $7C00; + gesamt:=r16+g16+b16; + Result.imgdata[((Result.imgx*y+x)*2)+0]:=gesamt AND $00FF; + Result.imgdata[((Result.imgx*y+x)*2)+1]:=(gesamt AND $FF00) DIV 256; + END; + END; + END; + + Result.imgdata:=RevertImage(Result.imgx,Result.imgy,Result.imgdepth,Result.imgdata); + END; + +FUNCTION LoadTXMBconnected(fileid:LongWord):TImgPackage; + VAR + i,x,y,x2,y2,pixelid,imgid:LongWord; + rows,cols:Word; + linkcount:LongWord; + link:LongWord; + single_image:TImgPackage; + images_decoded:Array OF TImgPackage; + x_start,y_start:LongWord; + BEGIN + LoadDatFilePart(fileid,$10,SizeOf(Result.imgx),@Result.imgx); + LoadDatFilePart(fileid,$12,SizeOf(Result.imgy),@Result.imgy); + LoadDatFilePart(fileid,$18,SizeOf(cols),@cols); + LoadDatFilePart(fileid,$1A,SizeOf(rows),@rows); + LoadDatFilePart(fileid,$1C,SizeOf(linkcount),@linkcount); + SetLength(images_decoded,linkcount); + FOR i:=0 TO linkcount-1 DO BEGIN + LoadDatFilePart(fileid,$20+i*4,SizeOf(link),@link); + link:=link DIV 256; + single_image:=LoadImgData(link); + images_decoded[i]:=BmpToImgdata(ImgdataToBmp(single_image.imgx,single_image.imgy,single_image.imgdepth,single_image.storetype,single_image.imgdata),False); + END; + SetLength(Result.imgdata,Result.imgx*Result.imgy*2); + FOR y:=0 TO rows-1 DO BEGIN + FOR x:=0 TO cols-1 DO BEGIN + imgid:=y*cols+x; + x_start:=0; + y_start:=0; + FOR i:=0 TO x DO IF i=400 THEN BEGIN + END ELSE Form7.Width:=400; + IF Form7.Height>=350 THEN BEGIN + END ELSE Form7.Height:=350; + END; + +PROCEDURE TForm7.list_txmpClick(Sender: TObject); + VAR + id:LongWord; + data:Tdata; + img:TImgPackage; + mem:TMemoryStream; + fadingbyte,depthbyte,storebyte:Byte; + BEGIN + id:=StrToInt(MidStr(list_txmp.Items.Strings[list_txmp.ItemIndex],1,5)); + + LoadDatFilePart(id,$88,SizeOf(fadingbyte),@fadingbyte); + LoadDatFilePart(id,$89,SizeOf(depthbyte),@depthbyte); + LoadDatFilePart(id,$90,SizeOf(storebyte),@storebyte); + Form7.check_fading.Checked:=(fadingbyte AND $01)>0; + Form7.check_transparency.Checked:=(depthbyte AND $04)>0; + Form7.check_32bit.Checked:=(storebyte=8); + + img:=LoadImgData(id); + data:=ImgdataToBmp(img.imgx,img.imgy,img.imgdepth,img.storetype,img.imgdata); + + mem:=TMemoryStream.Create; + mem.Write(data[0],Length(data)); + mem.Seek(0,soFromBeginning); + Form7.image_txmppreview.Picture.Bitmap.LoadFromStream(mem); + mem.Free; + + Form7.group_bmpselect.Enabled:=True; + END; + +PROCEDURE TForm7.btn_loadClick(Sender: TObject); + VAR + bmpfile:TFileStream; + mem:TMemoryStream; + BEGIN + IF opend.Execute THEN BEGIN + bmpfile:=TFileStream.Create(opend.FileName, fmOpenRead); + SetLength(actual_bmpdata,bmpfile.Size); + bmpfile.Read(actual_bmpdata[0],bmpfile.Size); + bmpfile.Free; + + mem:=TMemoryStream.Create; + mem.Write(actual_bmpdata[0],Length(actual_bmpdata)); + mem.Seek(0,soFromBeginning); + Form7.image_bmppreview.Picture.Bitmap.LoadFromStream(mem); + mem.Free; + + Form7.group_options.Enabled:=True; + END; + END; + +PROCEDURE TForm7.btn_replaceClick(Sender: TObject); + VAR + id:LongWord; + imgpkg:TImgPackage; + rawfile:TFileStream; + datfile:TFileStream; + dataddr:LongWord; + old_rawaddr,new_rawaddr:LongWord; + oldwidth,oldheight:Word; + oldstore,olddepth,oldfading:Byte; + oldsize:LongWord; + newsize:LongWord; + datbyte:Word; + BEGIN + IF Form7.list_txmp.ItemIndex>=0 THEN BEGIN + imgpkg:=BmpToImgdata(actual_bmpdata,check_32bit.Checked); + datfile:=TFileStream.Create(dat_filename,fmOpenReadWrite); + + id:=StrToInt(MidStr(list_txmp.Items.Strings[list_txmp.ItemIndex],1,5)); + dataddr:=dat_files[id].dataddr; + datfile.Seek(dataddr+$8C,soFromBeginning); + datfile.Read(oldwidth,2); + datfile.Seek(dataddr+$8E,soFromBeginning); + datfile.Read(oldheight,2); + datfile.Seek(dataddr+$88,soFromBeginning); + datfile.Read(oldfading,1); + datfile.Seek(dataddr+$89,soFromBeginning); + datfile.Read(olddepth,1); + datfile.Seek(dataddr+$90,soFromBeginning); + datfile.Read(oldstore,1); + datfile.Seek(dataddr+$9C,soFromBeginning); + datfile.Read(old_rawaddr,4); + IF (oldwidth<>imgpkg.imgx) OR (oldheight<>imgpkg.imgy) THEN BEGIN + IF MessageBox(Form7.Handle, + PChar('Current image and new image have different size'+CrLf+ + '(Current: '+IntToStr(oldwidth)+'x'+IntToStr(oldheight)+ + ' - New: '+IntToStr(imgpkg.imgx)+'x'+IntToStr(imgpkg.imgy)+')'+CrLf+ + 'Replace anyways?'), + PChar(list_txmp.Items.Strings[list_txmp.ItemIndex]), + MB_YESNO)=IDNO THEN Exit; + END; + + rawfile:=TFileStream.Create(raw_filename,fmOpenReadWrite); + + CASE oldstore OF + 9: oldsize:=GetImageDataSize(oldwidth,oldheight,8,(oldfading AND $01)>0); + 0,1,2: oldsize:=GetImageDataSize(oldwidth,oldheight,16,(oldfading AND $01)>0); + 8: oldsize:=GetImageDataSize(oldwidth,oldheight,32,(oldfading AND $01)>0); + ELSE + oldsize:=0; + END; + IF check_32bit.Checked THEN + newsize:=GetImageDataSize(imgpkg.imgx,imgpkg.imgy,32,Form7.check_fading.Checked) + ELSE + newsize:=GetImageDataSize(imgpkg.imgx,imgpkg.imgy,16,Form7.check_fading.Checked); + + IF newsize<=oldsize THEN + new_rawaddr:=old_rawaddr + ELSE + new_rawaddr:=rawfile.Size; + + datbyte:=$00; + IF Form7.check_fading.Checked THEN datbyte:=datbyte OR $01; + datfile.Seek(dataddr+$88,soFromBeginning); + datfile.Write(datbyte,1); + datbyte:=$10; + IF Form7.check_transparency.Checked THEN datbyte:=datbyte OR $04; + datfile.Seek(dataddr+$89,soFromBeginning); + datfile.Write(datbyte,1); + datfile.Seek(dataddr+$8C,soFromBeginning); + datfile.Write(imgpkg.imgx,2); + datfile.Seek(dataddr+$8E,soFromBeginning); + datfile.Write(imgpkg.imgy,2); + IF check_32bit.Checked THEN + datbyte:=$08 + ELSE + datbyte:=$01; + datfile.Seek(dataddr+$90,soFromBeginning); + datfile.Write(datbyte,1); + datfile.Seek(dataddr+$9C,soFromBeginning); + datfile.Write(new_rawaddr,4); + datfile.Free; + + IF Form7.check_fading.Checked THEN BEGIN + imgpkg.imgdata:=CreateFadedImage(imgpkg); + END; + + rawfile.Seek(new_rawaddr,soFromBeginning); + rawfile.Write(imgpkg.imgdata[0],Length(imgpkg.imgdata)); + rawfile.Free; + + ShowMessage('TXMP-image replaced'); + END; + END; + +END. Index: /oup/releases/0.17a/Unit8_binedit.dfm =================================================================== --- /oup/releases/0.17a/Unit8_binedit.dfm (revision 21) +++ /oup/releases/0.17a/Unit8_binedit.dfm (revision 21) @@ -0,0 +1,113 @@ +object Form8: TForm8 + Left = 0 + Top = 0 + AutoScroll = False + BorderStyle = bsSizeToolWin + Caption = 'Binary .dat-Editor' + ClientHeight = 426 + ClientWidth = 642 + Color = clBtnFace + Font.Charset = DEFAULT_CHARSET + Font.Color = clWindowText + Font.Height = -11 + Font.Name = 'Tahoma' + Font.Style = [] + OldCreateOrder = False + OnCloseQuery = FormCloseQuery + OnCreate = FormCreate + OnResize = FormResize + PixelsPerInch = 96 + TextHeight = 13 + object Splitter1: TSplitter + Left = 161 + Top = 0 + Width = 9 + Height = 426 + AutoSnap = False + Beveled = True + MinSize = 100 + end + object list: TListBox + Left = 0 + Top = 0 + Width = 161 + Height = 426 + Align = alLeft + ItemHeight = 13 + TabOrder = 0 + OnClick = listClick + end + object panel_data: TPanel + Left = 170 + Top = 0 + Width = 472 + Height = 426 + Align = alClient + BevelOuter = bvNone + TabOrder = 1 + OnResize = panel_dataResize + object Splitter2: TSplitter + Left = 0 + Top = 300 + Width = 472 + Height = 9 + Cursor = crVSplit + Align = alTop + AutoSnap = False + Beveled = True + MinSize = 100 + end + object hex: TMPHexEditor + Left = 0 + Top = 0 + Width = 472 + Height = 300 + Cursor = crIBeam + Align = alTop + Font.Charset = DEFAULT_CHARSET + Font.Color = clWindowText + Font.Height = -16 + Font.Name = 'Courier' + Font.Style = [] + ParentFont = False + ScrollBars = ssVertical + TabOrder = 0 + BytesPerRow = 16 + Translation = tkASCII + OffsetFormat = '6!10:0x|' + Colors.Background = clWindow + Colors.ChangedBackground = clWindow + Colors.ChangedText = clRed + Colors.CursorFrame = clNavy + Colors.Offset = clBlack + Colors.OddColumn = clBlue + Colors.EvenColumn = clNavy + Colors.CurrentOffsetBackground = clBtnShadow + Colors.OffsetBackGround = clBtnFace + Colors.CurrentOffset = clBtnHighlight + Colors.Grid = clBtnFace + Colors.NonFocusCursorFrame = clAqua + Colors.ActiveFieldBackground = clWindow + FocusFrame = True + AllowInsertMode = False + DrawGridLines = False + Version = 'May 23, 2005; '#169' markus stephany, vcl[at]mirkes[dot]de' + OnChange = hexChange + ShowPositionIfNotFocused = True + OnSelectionChanged = hexSelectionChanged + end + object structs: TWrapGrid + Left = 0 + Top = 309 + Width = 472 + Height = 117 + Align = alClient + DefaultColWidth = 92 + DefaultRowHeight = 18 + FixedCols = 0 + Options = [goFixedVertLine, goFixedHorzLine, goVertLine, goHorzLine] + TabOrder = 1 + OnClick = structsClick + end + end +end Index: /oup/releases/0.17a/Unit8_binedit.pas =================================================================== --- /oup/releases/0.17a/Unit8_binedit.pas (revision 21) +++ /oup/releases/0.17a/Unit8_binedit.pas (revision 21) @@ -0,0 +1,235 @@ +UNIT Unit8_binedit; +INTERFACE +USES + Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, + Dialogs, Wrapgrid, StdCtrls, Grids, StrUtils, MPHexEditor, ExtCtrls, + Unit3_data, Unit2_functions, Unit9_data_structures; + +TYPE + TForm8 = Class(TForm) + list: TListBox; + Splitter1: TSplitter; + panel_data: TPanel; + hex: TMPHexEditor; + Splitter2: TSplitter; + structs: TWrapGrid; + PROCEDURE hexSelectionChanged(Sender: TObject); + PROCEDURE hexChange(Sender: TObject); + PROCEDURE panel_dataResize(Sender: TObject); + PROCEDURE structsClick(Sender: TObject); + PROCEDURE FormResize(Sender: TObject); + PROCEDURE ClearStructViewer; + PROCEDURE listClick(Sender: TObject); + PROCEDURE FormCloseQuery(Sender: TObject; var CanClose: Boolean); + PROCEDURE FormCreate(Sender: TObject); + PROCEDURE Recreatelist; + PRIVATE + PUBLIC + END; + +VAR + Form8: TForm8; + +IMPLEMENTATION +{$R *.dfm} +VAR + fileid:LongWord; + +FUNCTION IntToBin(value:Byte):String; + VAR i:Byte; + BEGIN + Result:=''; + FOR i:=7 DOWNTO 0 DO BEGIN + Result:=Result+IntToStr((value SHR i) AND $01); + END; + END; + +FUNCTION GetTypeDataLength(datatype:Byte):Byte; + BEGIN + CASE datatype OF + 1..4: Result:=datatype; + 5..8: Result:=datatype-4; + 9: Result:=4; + 10: Result:=1; + 11..255: Result:=datatype-10; + END; + END; + +FUNCTION GetValue(datatype:Byte; offset:LongWord):String; + VAR + data:Tdata; + BEGIN + CASE datatype OF + 1: Result:=IntToStr(Form8.hex.data[offset]); + 2: Result:=IntToStr(Form8.hex.data[offset]+Form8.hex.data[offset+1]*256); + 3: Result:=IntToStr(Form8.hex.data[offset]+Form8.hex.data[offset+1]*256+Form8.hex.data[offset+2]*256*256); + 4: Result:=IntToStr(Form8.hex.data[offset]+Form8.hex.data[offset+1]*256+Form8.hex.data[offset+2]*256*256+Form8.hex.data[offset+3]*256*256*256); + 5: Result:='0x'+IntToHex(Form8.hex.data[offset],2); + 6: Result:='0x'+IntToHex(Form8.hex.data[offset]+Form8.hex.data[offset+1]*256,4); + 7: Result:='0x'+IntToHex(Form8.hex.data[offset]+Form8.hex.data[offset+1]*256+Form8.hex.data[offset+2]*256*256,6); + 8: Result:='0x'+IntToHex(Form8.hex.data[offset]+Form8.hex.data[offset+1]*256+Form8.hex.data[offset+2]*256*256+Form8.hex.data[offset+3]*256*256*256,8); + 9: BEGIN + SetLength(data,4); + data[0]:=Form8.hex.data[offset]; + data[1]:=Form8.hex.data[offset+1]; + data[2]:=Form8.hex.data[offset+2]; + data[3]:=Form8.hex.data[offset+3]; + Result:=FloatToStr(Decode_Float(data)); + END; + 10: Result:=IntToBin(Form8.hex.data[offset]); + END; + END; + +PROCEDURE WriteStructureInfos(structinfoid:Integer); + VAR + i:Byte; + BEGIN + IF structinfoid>=0 THEN BEGIN + WITH structure_infos[structinfoid] DO BEGIN + Form8.structs.RowCount:=Length(entries)+1; + FOR i:=1 TO Length(entries) DO BEGIN + Form8.structs.Cells[0,i]:=entries[i-1].name; + Form8.structs.Cells[1,i]:='0x'+IntToHex(entries[i-1].offset,6); + Form8.structs.Cells[2,i]:=GetDataType(entries[i-1].datatype); + Form8.structs.Cells[3,i]:=GetValue(entries[i-1].datatype,entries[i-1].offset); + Form8.structs.Cells[4,i]:=entries[i-1].description; + END; + END; + END; + END; + +PROCEDURE TForm8.Recreatelist; + VAR + i:LongWord; + BEGIN + Form8.list.Items.Clear; + FOR i:=0 TO dat_header.Files-1 DO BEGIN + IF (dat_files[i].FileType AND $02)=0 THEN + Form8.list.Items.Add(dat_files[i].FileName); + END; + END; + +PROCEDURE TForm8.FormCreate(Sender: TObject); + BEGIN + Form8.Caption:=''; + fileid:=0; + structs.ColCount:=5; + structs.RowCount:=2; + structs.FixedRows:=1; + structs.Cells[0,0]:='Name'; + structs.Cells[1,0]:='Offset'; + structs.Cells[2,0]:='Type'; + structs.Cells[3,0]:='Value'; + structs.Cells[4,0]:='Description'; + structs.ColWidths[0]:=75; + structs.ColWidths[1]:=60; + structs.ColWidths[2]:=75; + structs.ColWidths[3]:=75; + Form8.panel_dataResize(Form8); + END; + +PROCEDURE TForm8.FormCloseQuery(Sender: TObject; var CanClose: Boolean); + BEGIN + CanClose:=False; + Form8.Visible:=False; + END; + +PROCEDURE TForm8.listClick(Sender: TObject); + VAR + mem:TMemoryStream; + data:Tdata; + BEGIN + IF hex.Modified THEN BEGIN + IF MessageBox(Form8.Handle,PChar('Save changes to file '+dat_files[fileid].FileName+'?'),PChar('Data changed...'),MB_YESNO)=IDYES THEN BEGIN + mem:=TMemoryStream.Create; + hex.SaveToStream(mem); + mem.Seek(0,soFromBeginning); + SetLength(data,mem.Size); + mem.Read(data[0],mem.Size); + mem.Free; + SaveDatFile(fileid,data); + ShowMessage('Changes saved...'); + END; + END; + Form8.ClearStructViewer; + fileid:=StrToInt(MidStr(list.Items.Strings[list.ItemIndex],1,5)); + data:=LoadDatFile(fileid); + mem:=TMemoryStream.Create; + mem.Write(data[0],Length(data)); + hex.LoadFromStream(mem); + mem.Free; + WriteStructureInfos(GetStructureInfoId(dat_files[fileid].Extension)); + END; + +PROCEDURE TForm8.ClearStructViewer; + VAR + x:Word; + BEGIN + structs.RowCount:=2; + FOR x:=0 TO structs.ColCount-1 DO structs.Cells[x,1]:=''; + END; + +PROCEDURE TForm8.FormResize(Sender: TObject); + BEGIN + IF Form8.Width>=650 THEN BEGIN + END ELSE Form8.Width:=650; + IF Form8.Height>=450 THEN BEGIN + END ELSE Form8.Height:=450; + END; + +PROCEDURE TForm8.structsClick(Sender: TObject); + VAR + offset:LongWord; + length:Byte; + BEGIN + IF structs.Row>0 THEN BEGIN + offset:=structure_infos[GetStructureInfoId(dat_files[fileid].extension)].entries[structs.Row-1].offset; + length:=GetTypeDataLength(structure_infos[GetStructureInfoId(dat_files[fileid].extension)].entries[structs.Row-1].datatype); + hex.SelStart:=offset; + hex.SelEnd:=offset+length-1; + END; + END; + +PROCEDURE TForm8.panel_dataResize(Sender: TObject); + BEGIN + structs.ColWidths[4]:=structs.Width-structs.ColWidths[0]-structs.ColWidths[1]-structs.ColWidths[2]-structs.ColWidths[3]-12; + END; + +PROCEDURE TForm8.hexChange(Sender: TObject); + BEGIN + IF hex.DataSize>0 THEN + WriteStructureInfos(GetStructureInfoId(dat_files[fileid].Extension)); + END; + +PROCEDURE TForm8.hexSelectionChanged(Sender: TObject); + VAR + selstart,sellength,selend:Integer; + i,j:Word; + BEGIN + FOR i:=1 TO structs.RowCount-1 DO BEGIN + FOR j:=0 TO structs.ColCount-1 DO BEGIN + structs.CellColors[j,i]:=clWhite; + structs.CellFontColors[j,i]:=clBlack; + END; + END; + IF hex.DataSize>0 THEN BEGIN + selstart:=hex.SelStart; + selend:=hex.SelEnd; + sellength:=hex.SelCount; + IF GetStructureInfoId(dat_files[fileid].Extension)>=0 THEN BEGIN + WITH structure_infos[GetStructureInfoId(dat_files[fileid].Extension)] DO BEGIN + FOR i:=0 TO High(entries) DO BEGIN + IF ((selstart-entries[i].offset)=0) THEN BEGIN + FOR j:=0 TO structs.ColCount-1 DO BEGIN + structs.CellColors[j,i+1]:=clBlue; + structs.CellFontColors[j,i+1]:=clWhite; + END; + structs.Row:=i+1; + END; + END; + END; + END; + END; + END; + +END. Index: /oup/releases/0.17a/Unit9_data_structures.pas =================================================================== --- /oup/releases/0.17a/Unit9_data_structures.pas (revision 21) +++ /oup/releases/0.17a/Unit9_data_structures.pas (revision 21) @@ -0,0 +1,91 @@ +UNIT Unit9_data_structures; +INTERFACE +USES SysUtils; + +TYPE + Tstructure_entry=RECORD + name:String; + offset:LongWord; + datatype:Byte; // 1..4: Integer[1..4] dec; 5..8: Integer[1..4] hex; 9: float; 10: bitset; 11+: string[1+] + description:String; + END; + Tstructure_info=RECORD + extension:String; + typedesc:String; + entries:Array OF Tstructure_entry; + END; + Tstructures=Array OF Tstructure_info; + +VAR + structure_infos:Tstructures; + + +FUNCTION GetDataType(typeid:Byte):String; +FUNCTION GetStructureInfoId(ext:String):Integer; + + + +IMPLEMENTATION + +FUNCTION GetStructureInfoId(ext:String):Integer; + VAR + i:Integer; + BEGIN + FOR i:=0 TO High(structure_infos) DO BEGIN + IF structure_infos[i].extension=ext THEN BEGIN + Result:=i; + Exit; + END; + END; + Result:=-1; + END; + +FUNCTION GetDataType(typeid:Byte):String; + BEGIN + CASE typeid OF + 1..4: Result:='Int'+IntToStr(typeid*8); + 5..8: Result:='Int'+IntToStr((typeid-4)*8); + 9: Result:='Float'; + 10: Result:='BitSet'; + 11..255: Result:='String('+IntToStr(typeid-10)+')'; + END; + END; + +PROCEDURE AddEntry(_ext:String; _name:String; _offset:LongWord; _datatype:Byte; _description:String); + VAR + sid:Word; + BEGIN + sid:=GetStructureInfoId(_ext); + IF sid>=0 THEN BEGIN + WITH structure_infos[sid] DO BEGIN + SetLength(entries,Length(entries)+1); + WITH entries[High(entries)] DO BEGIN + name:=_name; + offset:=_offset; + datatype:=_datatype; + description:=_description; + END; + END; + END; + END; + +PROCEDURE AddExtension(_ext:String; _typedesc:String); + BEGIN + IF GetStructureInfoId(_ext)<0 THEN BEGIN + SetLength(structure_infos,Length(structure_infos)+1); + WITH structure_infos[High(structure_infos)] DO BEGIN + extension:='TXMP'; + typedesc:='Texture'; + END; + END; + END; + +BEGIN + AddExtension('TXMP','Texture'); + AddEntry('TXMP','Fading',$88,10,'Fading-Bitset'); + AddEntry('TXMP','Depth',$89,10,'Depth-Bitset'); + AddEntry('TXMP','Width',$8C,2,'x-resolution of image'); + AddEntry('TXMP','Height',$8E,2,'y-resolution of image'); + AddEntry('TXMP','Storetype',$90,10,'Storetype-Bitset'); + AddEntry('TXMP','Raw-Link',$9C,8,'Address of the image data in the .raw-file'); +END. Index: /oup/releases/0.18a/OniUnPacker.bdsproj =================================================================== --- /oup/releases/0.18a/OniUnPacker.bdsproj (revision 21) +++ /oup/releases/0.18a/OniUnPacker.bdsproj (revision 21) @@ -0,0 +1,171 @@ + + + + + + + + + + + + OniUnPacker.dpr + + + 7.0 + + + 8 + 0 + 1 + 1 + 0 + 0 + 1 + 1 + 1 + 0 + 0 + 1 + 0 + 1 + 1 + 1 + 0 + 0 + 0 + 0 + 0 + 1 + 0 + 1 + 1 + 1 + True + True + WinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE; + + False + + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + False + False + False + True + True + True + + + 0 + 0 + 1 + False + False + False + 16384 + 1048576 + 4194304 + + + + + + + + + xmlrtl;rtl;vcl;vclie;inet;inetdbbde;inetdbxpress;vclx;IndySystem;IndyCore;dbrtl;dsnap;soaprtl;IndyProtocols;bdertl;vcldbx;vcldb;webdsnap;websnap;vclactnband;GridPackd2005;TWrapGrid;Package1;A406_R70;CoolTrayIcon_D6plus + + + False + + + + + + False + + + + + + False + + + False + False + 1 + 0 + 0 + 0 + False + False + False + False + False + 1031 + 1252 + + + + + 1.0.0.0 + + + + + + 1.0.0.0 + + + (untitled) + Borland Web Wizard Package + + + Index: /oup/releases/0.18a/OniUnPacker.cfg =================================================================== --- /oup/releases/0.18a/OniUnPacker.cfg (revision 21) +++ /oup/releases/0.18a/OniUnPacker.cfg (revision 21) @@ -0,0 +1,38 @@ +-$A8 +-$B- +-$C+ +-$D+ +-$E- +-$F- +-$G+ +-$H+ +-$I+ +-$J- +-$K- +-$L+ +-$M- +-$N+ +-$O+ +-$P+ +-$Q- +-$R- +-$S- +-$T- +-$U- +-$V+ +-$W- +-$X+ +-$YD +-$Z1 +-cg +-AWinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE; +-H+ +-W+ +-M +-$M16384,1048576 +-K$00400000 +-LE"C:\Dokumente und Einstellungen\Administrator\Eigene Dateien\Borland Studio Projects\Bpl" +-LN"C:\Dokumente und Einstellungen\Administrator\Eigene Dateien\Borland Studio Projects\Bpl" +-w-UNSAFE_TYPE +-w-UNSAFE_CODE +-w-UNSAFE_CAST Index: /oup/releases/0.18a/OniUnPacker.dpr =================================================================== --- /oup/releases/0.18a/OniUnPacker.dpr (revision 21) +++ /oup/releases/0.18a/OniUnPacker.dpr (revision 21) @@ -0,0 +1,21 @@ +PROGRAM OniUnPacker; +uses + Forms, + Unit1_main in 'Unit1_main.pas' {Form1}, + Unit2_functions in 'Unit2_functions.pas', + Unit3_data in 'Unit3_data.pas', + Unit4_Exporters in 'Unit4_Exporters.pas', + Unit5_preview in 'Unit5_preview.pas' {Form5}, + Unit6_imgfuncs in 'Unit6_imgfuncs.pas', + Unit7_txmpreplace in 'Unit7_txmpreplace.pas' {Form7}, + Unit8_binedit in 'Unit8_binedit.pas' {Form8}, + Unit9_data_structures in 'Unit9_data_structures.pas'; + +{$R *.res} + +BEGIN + Application.Initialize; + Application.Title:='Oni Un/Packer'; + Application.CreateForm(TForm1, Form1); + Application.Run; +END. Index: /oup/releases/0.18a/SQLite3.pas =================================================================== --- /oup/releases/0.18a/SQLite3.pas (revision 21) +++ /oup/releases/0.18a/SQLite3.pas (revision 21) @@ -0,0 +1,120 @@ +unit SQLite3; + +{ + Simplified interface for SQLite. + Updated for Sqlite 3 by Tim Anderson (tim@itwriting.com) + Note: NOT COMPLETE for version 3, just minimal functionality + Adapted from file created by Pablo Pissanetzky (pablo@myhtpc.net) + which was based on SQLite.pas by Ben Hochstrasser (bhoc@surfeu.ch) +} + +interface + +const +// Return values for sqlite3_exec() and sqlite3_step() + +SQLITE_OK = 0; // Successful result +SQLITE_ERROR = 1; // SQL error or missing database +SQLITE_INTERNAL = 2; // An internal logic error in SQLite +SQLITE_PERM = 3 ; // Access permission denied +SQLITE_ABORT = 4; // Callback routine requested an abort +SQLITE_BUSY = 5; // The database file is locked +SQLITE_LOCKED = 6; // A table in the database is locked +SQLITE_NOMEM = 7; // A malloc() failed +SQLITE_READONLY = 8; // Attempt to write a readonly database +SQLITE_INTERRUPT = 9; // Operation terminated by sqlite3_interrupt() +SQLITE_IOERR = 10; // Some kind of disk I/O error occurred +SQLITE_CORRUPT = 11; // The database disk image is malformed +SQLITE_NOTFOUND = 12; // (Internal Only) Table or record not found +SQLITE_FULL = 13; // Insertion failed because database is full +SQLITE_CANTOPEN = 14; // Unable to open the database file +SQLITE_PROTOCOL = 15; // Database lock protocol error +SQLITE_EMPTY = 16; // Database is empty +SQLITE_SCHEMA = 17; // The database schema changed +SQLITE_TOOBIG = 18; // Too much data for one row of a table +SQLITE_CONSTRAINT = 19; // Abort due to contraint violation +SQLITE_MISMATCH = 20; // Data type mismatch +SQLITE_MISUSE = 21; // Library used incorrectly +SQLITE_NOLFS = 22; // Uses OS features not supported on host +SQLITE_AUTH = 23; // Authorization denied +SQLITE_FORMAT = 24; // Auxiliary database format error +SQLITE_RANGE = 25; // 2nd parameter to sqlite3_bind out of range +SQLITE_NOTADB = 26; // File opened that is not a database file +SQLITE_ROW = 100; // sqlite3_step() has another row ready +SQLITE_DONE = 101; // sqlite3_step() has finished executing + +SQLITE_INTEGER = 1; +SQLITE_FLOAT = 2; +SQLITE_TEXT = 3; +SQLITE_BLOB = 4; +SQLITE_NULL = 5; + +type +TSQLiteDB = Pointer; +TSQLiteResult = ^PChar; +TSQLiteStmt = Pointer; + +function SQLite3_Open (dbname: PChar; var db: TSqliteDB): integer; cdecl; external 'sqlite3.dll' name 'sqlite3_open'; +function SQLite3_Close (db: TSQLiteDB): integer; cdecl; external 'sqlite3.dll' name 'sqlite3_close'; +function SQLite3_Exec (db: TSQLiteDB; SQLStatement: PChar; CallbackPtr: Pointer; Sender: TObject; var ErrMsg: PChar): integer; cdecl; external 'sqlite3.dll' name 'sqlite3_exec'; +function SQLite3_Version (): PChar; cdecl; external 'sqlite3.dll' name 'sqlite3_libversion'; +function SQLite3_ErrMsg (db: TSQLiteDB): PChar; cdecl; external 'sqlite3.dll' name 'sqlite3_errmsg'; +function SQLite3_ErrCode (db: TSQLiteDB): integer; cdecl; external 'sqlite3.dll' name 'sqlite3_errcode'; +procedure SQlite3_Free (P: PChar); cdecl; external 'sqlite3.dll' name 'sqlite3_free'; +function SQLite3_GetTable (db: TSQLiteDB; SQLStatement: PChar; var ResultPtr: TSQLiteResult; var RowCount: Cardinal; var ColCount: Cardinal; var ErrMsg: PChar): integer; cdecl; external 'sqlite3.dll' name 'sqlite3_get_table'; +procedure SQLite3_FreeTable (Table:TSQLiteResult ); cdecl; external 'sqlite3.dll' name 'sqlite3_free_table'; +function SQLite3_Complete (P: PChar): boolean; cdecl; external 'sqlite3.dll' name 'sqlite3_complete'; +function SQLite3_LastInsertRowID(db: TSQLiteDB): int64; cdecl; external 'sqlite3.dll' name 'sqlite3_last_insert_rowid'; +procedure SQLite3_Interrupt (db: TSQLiteDB); cdecl; external 'sqlite3.dll' name 'sqlite3_interrupt'; +procedure SQLite3_BusyHandler (db: TSQLiteDB; CallbackPtr: Pointer; Sender: TObject); cdecl; external 'sqlite3.dll' name'sqlite3_busy_handler' ; +procedure SQLite3_BusyTimeout (db: TSQLiteDB; TimeOut: integer); cdecl; external 'sqlite3.dll' name 'sqlite3_busy_timeout'; +function SQLite3_Changes (db: TSQLiteDB): integer; cdecl; external 'sqlite3.dll' name 'sqlite3_changes'; +function SQLite3_TotalChanges (db: TSQLiteDB): integer; cdecl; external 'sqlite3.dll' name 'sqlite3_total_changes'; +function SQLite3_Prepare (db: TSQLiteDB; SQLStatement: PChar; nBytes: integer; var hStmt: TSqliteStmt; var pzTail: PChar): integer; cdecl; external 'sqlite3.dll' name 'sqlite3_prepare'; +function SQLite3_ColumnCount (hStmt: TSqliteStmt): integer; cdecl; external 'sqlite3.dll' name 'sqlite3_column_count'; +function Sqlite3_ColumnName (hStmt: TSqliteStmt; ColNum: integer): pchar; cdecl; external 'sqlite3.dll' name 'sqlite3_column_name'; +function Sqlite3_ColumnDeclType (hStmt: TSqliteStmt; ColNum: integer): pchar; cdecl; external 'sqlite3.dll' name 'sqlite3_column_decltype'; +function Sqlite3_Step (hStmt: TSqliteStmt): integer; cdecl; external 'sqlite3.dll' name 'sqlite3_step'; +function SQLite3_DataCount (hStmt: TSqliteStmt): integer; cdecl; external 'sqlite3.dll' name 'sqlite3_data_count'; + +function Sqlite3_ColumnBlob (hStmt: TSqliteStmt; ColNum: integer):pointer; cdecl; external 'sqlite3.dll' name 'sqlite3_column_blob'; +function Sqlite3_ColumnBytes (hStmt: TSqliteStmt; ColNum: integer): integer; cdecl; external 'sqlite3.dll' name 'sqlite3_column_bytes'; +function Sqlite3_ColumnDouble (hStmt: TSqliteStmt; ColNum: integer): double; cdecl; external 'sqlite3.dll' name 'sqlite3_column_double'; +function Sqlite3_ColumnInt (hStmt: TSqliteStmt; ColNum: integer): integer; cdecl; external 'sqlite3.dll' name 'sqlite3_column_int'; +function Sqlite3_ColumnText (hStmt: TSqliteStmt; ColNum: integer): pchar; cdecl; external 'sqlite3.dll' name 'sqlite3_column_text'; +function Sqlite3_ColumnType (hStmt: TSqliteStmt; ColNum: integer): integer; cdecl; external 'sqlite3.dll' name 'sqlite3_column_type'; + // function Sqlite3_ColumnInt64 (hStmt: TSqliteStmt; ColNum: integer): SqliteInt64; cdecl; external 'sqlite3.dll' name 'sqlite3_column_int64'; +function SQLite3_Finalize (hStmt: TSqliteStmt): integer; cdecl; external 'sqlite3.dll' name 'sqlite3_finalize'; +function SQLite3_Reset (hStmt: TSqliteStmt): integer; cdecl; external 'sqlite3.dll' name 'sqlite3_reset'; + +// +// In the SQL strings input to sqlite3_prepare() and sqlite3_prepare16(), +// one or more literals can be replace by a wildcard "?" or ":N:" where +// N is an integer. These value of these wildcard literals can be set +// using the routines listed below. +// +// In every case, the first parameter is a pointer to the sqlite3_stmt +// structure returned from sqlite3_prepare(). The second parameter is the +// index of the wildcard. The first "?" has an index of 1. ":N:" wildcards +// use the index N. +// + // The fifth parameter to sqlite3_bind_blob(), sqlite3_bind_text(), and + //sqlite3_bind_text16() is a destructor used to dispose of the BLOB or +//text after SQLite has finished with it. If the fifth argument is the +// special value SQLITE_STATIC, then the library assumes that the information +// is in static, unmanaged space and does not need to be freed. If the +// fifth argument has the value SQLITE_TRANSIENT, then SQLite makes its +// own private copy of the data. +// +// The sqlite3_bind_* routine must be called before sqlite3_step() after +// an sqlite3_prepare() or sqlite3_reset(). Unbound wildcards are interpreted +// as NULL. +// + +function SQLite3_BindBlob(hStmt: TSqliteStmt; ParamNum: integer; +ptrData: pointer; numBytes: integer; ptrDestructor: pointer): integer; +cdecl; external 'sqlite3.dll' name 'sqlite3_bind_blob'; + +implementation + +end. Index: /oup/releases/0.18a/SQLiteTable3.pas =================================================================== --- /oup/releases/0.18a/SQLiteTable3.pas (revision 21) +++ /oup/releases/0.18a/SQLiteTable3.pas (revision 21) @@ -0,0 +1,883 @@ +unit SQLiteTable3; + +{ + Simple classes for using SQLite's exec and get_table. + + TSQLiteDatabase wraps the calls to open and close an SQLite database. + It also wraps SQLite_exec for queries that do not return a result set + + TSQLiteTable wraps sqlite_get_table. + It allows accessing fields by name as well as index and can step through a + result set with the Next procedure. + + Adapted by Tim Anderson (tim@itwriting.com) + Originally created by Pablo Pissanetzky (pablo@myhtpc.net) +} + +interface + +uses + Windows, SQLite3, Classes, Sysutils; + +const + dtStr = 0; + dtInt = 1; + dtBool = 2; + dtNumeric = 3; + dtBlob = 4; + +type + + ESQLiteException = class(Exception) + private + public + end; + + TSQLiteTable = class; + + TSQLiteDatabase = class + private + fDB: TSQLiteDB; + fInTrans: Boolean; + procedure RaiseError(s: string; SQL: string); + + public + constructor Create(const FileName: string); + destructor Destroy; override; + function GetTable(const SQL: string): TSQLiteTable; + procedure ExecSQL(const SQL: string); + procedure UpdateBlob(const SQL: string; BlobData: TStream); + procedure BeginTransaction; + procedure Commit; + procedure Rollback; + function TableExists(TableName: string): boolean; + function GetLastInsertRowID: int64; + + published + property isTransactionOpen: boolean read fInTrans; + + end; + + TSQLiteTable = class + private + fResults: TList; + fRowCount: Cardinal; + fColCount: Cardinal; + fCols: TStringList; + fColTypes: TList; + fRow: Cardinal; + + function GetFields(I: Integer): string; + function GetEOF: Boolean; + function GetBOF: Boolean; + function GetColumns(I: Integer): string; + function GetFieldByName(FieldName: string): string; + function GetFieldIndex(FieldName: string): integer; + function GetCount: Integer; + function GetCountResult: Integer; + + + public + constructor Create(DB: TSQLiteDatabase; const SQL: string); + destructor Destroy; override; + function FieldAsInteger(FieldName: string): integer; + function FieldAsBool(FieldName: string): boolean; + function FieldAsBlob(FieldName: string): TMemoryStream; + function FieldAsBlobText(FieldName: string): string; + function FieldIsNull(FieldName: string): boolean; + function FieldAsString(FieldName: string): string; + function FieldAsDouble(FieldName: string): double; +{ function FieldAsInteger(I: integer): integer; + function FieldAsBool(I: integer): boolean; + function FieldAsBlob(I: Integer): TMemoryStream; + function FieldAsBlobText(I: Integer): string; + function FieldIsNull(I: integer): boolean; + function FieldAsString(I: Integer): string; + function FieldAsDouble(I: Integer): double; +} function Next: Boolean; + function Previous: Boolean; + property EOF: Boolean read GetEOF; + property BOF: Boolean read GetBOF; + property Fields[I: Integer]: string read GetFields; + property FieldByName[FieldName: string]: string read GetFieldByName; + property FieldIndex[FieldName: string]: integer read GetFieldIndex; + property Columns[I: Integer]: string read GetColumns; + property ColCount: Cardinal read fColCount; + property RowCount: Cardinal read fRowCount; + property Row: Cardinal read fRow; + function MoveFirst: boolean; + function MoveLast: boolean; + + + property Count: Integer read GetCount; + + // The property CountResult is used when you execute count(*) queries. + // It returns 0 if the result set is empty or the value of the + // first field as an integer. + property CountResult: Integer read GetCountResult; + end; + + +procedure DisposePointer(ptr: pointer); cdecl; + +implementation + +uses + strutils; + + +procedure DisposePointer(ptr: pointer); cdecl; +begin + + if assigned(ptr) then + begin freemem(ptr) end; + +end; + +//------------------------------------------------------------------------------ +// TSQLiteDatabase +//------------------------------------------------------------------------------ + +constructor TSQLiteDatabase.Create(const FileName: string); +var + Msg: pchar; + iResult: integer; +begin + inherited Create; + + self.fInTrans := false; + + Msg := nil; + try + iResult := SQLite3_Open(PChar(FileName), Fdb); + + if iResult <> SQLITE_OK then + begin + if Assigned(Fdb) then + begin + Msg := Sqlite3_ErrMsg(Fdb); + raise ESqliteException.CreateFmt('Failed to open database "%s" : %s', [FileName, Msg]); + end + else + begin raise ESqliteException.CreateFmt('Failed to open database "%s" : unknown error', [FileName]) end; + end; + + //set a few configs + self.ExecSQL('PRAGMA SYNCHRONOUS=NORMAL;'); + + //this pragma not recommended and may disappear in future + //sqlite versions + //self.ExecSQL('PRAGMA full_column_names = 1;'); + + finally + if Assigned(Msg) then + begin SQLite3_Free(Msg) end; + end; + + +end; + + +//.............................................................................. + +destructor TSQLiteDatabase.Destroy; +begin + + if self.fInTrans then + begin self.ExecSQL('ROLLBACK;') end; //assume rollback + + if Assigned(fDB) then + begin SQLite3_Close(fDB) end; + + inherited; +end; + +function TSQLiteDatabase.GetLastInsertRowID: int64; +begin + result := Sqlite3_LastInsertRowID(self.fDB); +end; + +//.............................................................................. + +procedure TSQLiteDatabase.RaiseError(s: string; SQL: string); +//look up last error and raise and exception with an appropriate message +var + Msg: PChar; +begin + + Msg := nil; + + if sqlite3_errcode(self.fDB) <> SQLITE_OK then + Msg := sqlite3_errmsg(self.fDB); + + if Msg <> nil then + raise ESqliteException.CreateFmt(s + ' "%s" : %s', [SQL, Msg]) + else + raise ESqliteException.CreateFmt(s, [SQL, 'No message']); + +end; + +procedure TSQLiteDatabase.ExecSQL(const SQL: string); +var + Stmt: TSQLiteStmt; + NextSQLStatement: Pchar; + iStepResult: integer; +begin + try + + if Sqlite3_Prepare(self.fDB, PChar(SQL), -1, Stmt, NextSQLStatement) <> SQLITE_OK then + begin RaiseError('Error executing SQL', SQL) end; + + if (Stmt = nil) then + begin RaiseError('Could not prepare SQL statement', SQL) end; + + iStepResult := Sqlite3_step(Stmt); + + if (iStepResult <> SQLITE_DONE) then + begin RaiseError('Error executing SQL statement', SQL) end; + + finally + + if Assigned(Stmt) then + begin Sqlite3_Finalize(stmt) end; + + end; +end; + +procedure TSQLiteDatabase.UpdateBlob(const SQL: string; BlobData: TStream); +var + iSize: integer; + ptr: pointer; + Stmt: TSQLiteStmt; + Msg: Pchar; + NextSQLStatement: Pchar; + iStepResult: integer; + iBindResult: integer; +begin +//expects SQL of the form 'UPDATE MYTABLE SET MYFIELD = ? WHERE MYKEY = 1' + + if pos('?', SQL) = 0 then + begin RaiseError('SQL must include a ? parameter', SQL) end; + + Msg := nil; + try + + if Sqlite3_Prepare(self.fDB, PChar(SQL), -1, Stmt, NextSQLStatement) <> SQLITE_OK then + begin RaiseError('Could not prepare SQL statement', SQL) end; + + if (Stmt = nil) then + begin RaiseError('Could not prepare SQL statement', SQL) end; + +//now bind the blob data + iSize := BlobData.size; + + GetMem(ptr, iSize); + + if (ptr = nil) then + begin raise ESqliteException.CreateFmt('Error getting memory to save blob', [SQL, 'Error']) end; + + BlobData.position := 0; + BlobData.Read(ptr^, iSize); + + iBindResult := SQLite3_BindBlob(stmt, 1, ptr, iSize, @DisposePointer); + + if iBindResult <> SQLITE_OK then + begin RaiseError('Error binding blob to database', SQL) end; + + iStepResult := Sqlite3_step(Stmt); + + if (iStepResult <> SQLITE_DONE) then + begin RaiseError('Error executing SQL statement', SQL) end; + + finally + + if Assigned(Stmt) then + begin Sqlite3_Finalize(stmt) end; + + if Assigned(Msg) then + begin SQLite3_Free(Msg) end; + end; + +end; + +//.............................................................................. + +function TSQLiteDatabase.GetTable(const SQL: string): TSQLiteTable; +begin + Result := TSQLiteTable.Create(Self, SQL); +end; + +procedure TSQLiteDatabase.BeginTransaction; +begin + if not self.fInTrans then + begin + self.ExecSQL('BEGIN TRANSACTION;'); + self.fInTrans := true; + end + else + begin raise ESqliteException.Create('Transaction already open') end; +end; + +procedure TSQLiteDatabase.Commit; +begin + self.ExecSQL('COMMIT;'); + self.fInTrans := false; +end; + +procedure TSQLiteDatabase.Rollback; +begin + self.ExecSQL('ROLLBACK;'); + self.fInTrans := false; +end; + +function TSQLiteDatabase.TableExists(TableName: string): boolean; +var + sql: string; + ds: TSqliteTable; +begin +//returns true if table exists in the database + sql := 'select [sql] from sqlite_master where [type] = ''table'' and lower(name) = ''' + lowercase(TableName) + ''' '; + + try + + ds := self.GetTable(sql); + + result := (ds.Count > 0); + + finally + + freeandnil(ds); + + end; + +end; + + +//------------------------------------------------------------------------------ +// TSQLiteTable +//------------------------------------------------------------------------------ + +constructor TSQLiteTable.Create(DB: TSQLiteDatabase; const SQL: string); +var + Stmt: TSQLiteStmt; + NextSQLStatement: Pchar; + iStepResult: integer; + + ptr: pointer; + iNumBytes: integer; + thisBlobValue: TMemoryStream; + thisStringValue: pstring; + thisBoolValue: pBoolean; + thisDoubleValue: pDouble; + thisIntValue: pInteger; + thisColType: pInteger; + i: integer; + DeclaredColType: Pchar; + ActualColType: integer; + ptrValue: Pchar; + +begin + + try + + self.fRowCount := 0; + self.fColCount := 0; + +//if there are several SQL statements in SQL, NextSQLStatment points to the +//beginning of the next one. Prepare only prepares the first SQL statement. + + if Sqlite3_Prepare(Db.fDB, PChar(SQL), -1, Stmt, NextSQLStatement) <> SQLITE_OK then + begin Db.RaiseError('Error executing SQL', SQL) end; + + if (Stmt = nil) then + begin Db.RaiseError('Could not prepare SQL statement', SQL) end; + + iStepResult := Sqlite3_step(Stmt); + + while (iStepResult <> SQLITE_DONE) do + begin + + case iStepResult of + SQLITE_ROW: + begin + + inc(fRowCount); + + if (fRowCount = 1) then + begin + //get data types + fCols := TStringList.Create; + fCols.CaseSensitive := False; + fColTypes := TList.Create; + + fColCount := SQLite3_ColumnCount(stmt); + + for i := 0 to Pred(fColCount) do + begin + fCols.Add(Sqlite3_ColumnName(stmt, i)); + end; + + for i := 0 to Pred(fColCount) do + begin + + new(thisColType); + DeclaredColType := Sqlite3_ColumnDeclType(stmt, i); + + if DeclaredColType = nil then begin + //use the actual column type instead + //seems to be needed for last_insert_rowid + thisColType^ := Sqlite3_ColumnType(stmt, i); + end else begin + DeclaredColType := strupper(DeclaredColType); + + if DeclaredColType = 'INTEGER' then + begin thisColType^ := dtInt end + else + if DeclaredColType = 'BOOLEAN' then + begin thisColType^ := dtBool end + else + if (DeclaredColType = 'NUMERIC') or (DeclaredColType = 'FLOAT') or (DeclaredColType = 'DOUBLE') then + begin thisColType^ := dtNumeric end + else + if DeclaredColType = 'BLOB' then + begin thisColType^ := dtBlob end + else + begin thisColType^ := dtStr end; + end; + + fColTypes.Add(thiscoltype); + end; + + fResults := TList.Create; + + end; + + //get column values + for i := 0 to Pred(ColCount) do + begin + + ActualColType := Sqlite3_ColumnType(stmt, i); + if (ActualColType = SQLITE_NULL) then + begin fResults.Add(nil) end + else + begin + if pInteger(fColTypes[i])^ = dtInt then + begin + new(thisintvalue); + thisintvalue^ := Sqlite3_ColumnInt(stmt, i); + fResults.Add(thisintvalue); + end + else + if pInteger(fColTypes[i])^ = dtBool then + begin + new(thisboolvalue); + thisboolvalue^ := not (Sqlite3_ColumnInt(stmt, i) = 0); + fResults.Add(thisboolvalue); + end + else + if pInteger(fColTypes[i])^ = dtNumeric then + begin + new(thisdoublevalue); + thisdoublevalue^ := Sqlite3_ColumnDouble(stmt, i); + fResults.Add(thisdoublevalue); + end + else + if pInteger(fColTypes[i])^ = dtBlob then + begin + iNumBytes := Sqlite3_ColumnBytes(stmt, i); + + if iNumBytes = 0 then + begin thisblobvalue := nil end + else + begin + thisblobvalue := TMemoryStream.Create; + thisblobvalue.position := 0; + ptr := Sqlite3_ColumnBlob(stmt, i); + thisblobvalue.writebuffer(ptr^, iNumBytes); + end; + fResults.Add(thisblobvalue); + + end + else + begin + new(thisstringvalue); + ptrValue := Sqlite3_ColumnText(stmt, i); + setstring(thisstringvalue^, ptrvalue, strlen(ptrvalue)); + fResults.Add(thisstringvalue); + end; + end; + + end; + + + + end; + + SQLITE_BUSY: + begin raise ESqliteException.CreateFmt('Could not prepare SQL statement', [SQL, 'SQLite is Busy']) end; + else + begin Db.RaiseError('Could not retrieve data', SQL) end; + end; + + iStepResult := Sqlite3_step(Stmt); + + end; + + fRow := 0; + + finally + if Assigned(Stmt) then + begin Sqlite3_Finalize(stmt) end; + end; + +end; + +//.............................................................................. + +destructor TSQLiteTable.Destroy; +var i: integer; + iColNo: integer; +begin + + + if Assigned(fResults) then + begin for i := 0 to fResults.Count - 1 do + begin + //check for blob type + iColNo := (i mod fColCount); + case pInteger(self.fColTypes[iColNo])^ of + dtBlob: + begin + TMemoryStream(fResults[i]).free; + end; + dtStr: + begin + if fResults[i] <> nil then + begin + setstring(string(fResults[i]^), nil, 0); + dispose(fResults[i]); + end; + end; + else + begin + dispose(fResults[i]) + end; + end; + end; + fResults.Free; + end; + + if Assigned(fCols) then + begin fCols.Free end; + + if Assigned(fColTypes) then + begin for i := 0 to fColTypes.Count - 1 do + begin + dispose(fColTypes[i]); + end end; + fColTypes.Free; + inherited; + end; + +//.............................................................................. + +function TSQLiteTable.GetColumns(I: Integer): string; +begin + Result := fCols[I]; +end; + +//.............................................................................. + +function TSQLiteTable.GetCountResult: Integer; +begin + if not EOF then + begin Result := StrToInt(Fields[0]) end + else + begin Result := 0 end; +end; + +function TSQLiteTable.GetCount: Integer; +begin + Result := FRowCount; +end; + +//.............................................................................. + +function TSQLiteTable.GetEOF: Boolean; +begin + Result := fRow >= fRowCount; +end; + +function TSQLiteTable.GetBOF: Boolean; +begin + Result := fRow <= 0; +end; + +//.............................................................................. + +function TSQLiteTable.GetFieldByName(FieldName: string): string; +begin + Result := GetFields(self.GetFieldIndex(FieldName)); +end; + +function TSQLiteTable.GetFieldIndex(FieldName: string): integer; +begin + + if (fCols = nil) then + begin + raise ESqliteException.Create('Field ' + fieldname + ' Not found. Empty dataset'); + exit; + end; + + if (fCols.count = 0) then + begin + raise ESqliteException.Create('Field ' + fieldname + ' Not found. Empty dataset'); + exit; + end; + + result := fCols.IndexOf(FieldName); + + if (result < 0) then + begin raise ESqliteException.Create('Field not found in dataset: ' + fieldname) end; + +end; + +//.............................................................................. + +function TSQLiteTable.GetFields(I: Integer): string; +var + thisvalue: pstring; + ptr: pointer; + thisboolvalue: pBoolean; + thistype: integer; +begin + Result := ''; + + if EOF then + begin raise ESqliteException.Create('Table is at End of File') end; + +//integer and boolean types are not stored in the resultset +//as strings, so they should be retrieved using the type-specific +//methods + + thistype := pInteger(self.fColTypes[I])^; + + if (thistype = dtInt) or (thistype = dtNumeric) or (thistype = dtBlob) then + begin + ptr := self.fResults[(self.frow * self.fColCount) + I]; + + if ptr <> nil then + begin + raise ESqliteException.Create('Use the specific methods for integer, numeric or blob fields'); + end; + + end + else + if pInteger(self.fColTypes[I])^ = dtBool then + begin + thisboolvalue := self.fResults[(self.frow * self.fColCount) + I]; + if thisboolvalue <> nil then + begin if thisboolvalue^ then + begin result := '1' end + else + begin result := '0' end end; + end + + else + + begin + + thisvalue := self.fResults[(self.frow * self.fColCount) + I]; + if (thisvalue <> nil) then + begin Result := thisvalue^ end + else + begin Result := '' end; //return empty string + end; + +end; + +function TSqliteTable.FieldAsBlob(FieldName: string): TMemoryStream; +var + i: Integer; +begin + + if EOF then + begin raise ESqliteException.Create('Table is at End of File') end; + + i:=Self.FieldIndex[FieldName]; + + if (self.fResults[(self.frow * self.fColCount) + I] = nil) then + begin result := nil end + else + if pInteger(self.fColTypes[I])^ = dtBlob then + begin result := TMemoryStream(self.fResults[(self.frow * self.fColCount) + I]) end + else + begin raise ESqliteException.Create('Not a Blob field') end; +end; + +function TSqliteTable.FieldAsBlobText(FieldName: string): string; +var + MemStream: TMemoryStream; + Buffer: PChar; +begin + result := ''; + + MemStream := self.FieldAsBlob(FieldName); + + if MemStream <> nil then + begin if MemStream.Size > 0 then + begin + MemStream.position := 0; + + Buffer := stralloc(MemStream.Size + 1); + MemStream.readbuffer(Buffer[0], MemStream.Size); + (Buffer + MemStream.Size)^ := chr(0); + SetString(Result, Buffer, MemStream.size); + strdispose(Buffer); + end end; + +end; + + +function TSqliteTable.FieldAsInteger(FieldName: string): integer; +var + i: Integer; +begin + + if EOF then + begin raise ESqliteException.Create('Table is at End of File') end; + + i:=Self.FieldIndex[FieldName]; + + if (self.fResults[(self.frow * self.fColCount) + I] = nil) then + begin result := 0 end + else + if pInteger(self.fColTypes[I])^ = dtInt then + begin result := pInteger(self.fResults[(self.frow * self.fColCount) + I])^ end + else + if pInteger(self.fColTypes[I])^ = dtNumeric then + begin result := trunc(strtofloat(pString(self.fResults[(self.frow * self.fColCount) + I])^)) end + else + begin raise ESqliteException.Create('Not an integer or numeric field') end; + +end; + +function TSqliteTable.FieldAsDouble(FieldName: string): double; +var + i: Integer; +begin + + if EOF then + begin raise ESqliteException.Create('Table is at End of File') end; + + i:=Self.FieldIndex[FieldName]; + + if (self.fResults[(self.frow * self.fColCount) + I] = nil) then + begin result := 0 end + else + if pInteger(self.fColTypes[I])^ = dtInt then + begin result := pInteger(self.fResults[(self.frow * self.fColCount) + I])^ end + else + if pInteger(self.fColTypes[I])^ = dtNumeric then + begin result := pDouble(self.fResults[(self.frow * self.fColCount) + I])^ end + else + begin raise ESqliteException.Create('Not an integer or numeric field') end; + +end; + +function TSqliteTable.FieldAsBool(FieldName: string): boolean; +var + i: Integer; +begin + + if EOF then + begin raise ESqliteException.Create('Table is at End of File') end; + + i:=Self.FieldIndex[FieldName]; + + if (self.fResults[(self.frow * self.fColCount) + I] = nil) then + begin result := false end + else + if pInteger(self.fColTypes[I])^ = dtBool then + begin result := pBoolean(self.fResults[(self.frow * self.fColCount) + I])^ end + else + begin raise ESqliteException.Create('Not a boolean field') end; +end; + +function TSqliteTable.FieldAsString(FieldName: string): string; +var + i: Integer; +begin + + if EOF then + begin raise ESqliteException.Create('Table is at End of File') end; + + i:=Self.FieldIndex[FieldName]; + + if (self.fResults[(self.frow * self.fColCount) + I] = nil) then + begin result := '' end + else + begin result := self.GetFields(I) end; + +end; + +function TSqliteTable.FieldIsNull(FieldName: string): boolean; +var + thisvalue: pointer; + i: Integer; +begin + + if EOF then + begin raise ESqliteException.Create('Table is at End of File') end; + + i:=Self.FieldIndex[FieldName]; + + thisvalue := self.fResults[(self.frow * self.fColCount) + I]; + result := (thisvalue = nil); +end; + +//.............................................................................. + +function TSQLiteTable.Next: boolean; +begin + result := false; + if not EOF then + begin + Inc(fRow); + result := true; + end; +end; + +function TSQLiteTable.Previous: boolean; +begin + result := false; + if not BOF then + begin + Dec(fRow); + result := true; + end; +end; + +function TSQLiteTable.MoveFirst: boolean; +begin + result := false; + if self.fRowCount > 0 then + begin + fRow := 0; + result := true; + end; +end; + +function TSQLiteTable.MoveLast: boolean; +begin + result := false; + if self.fRowCount > 0 then + begin + fRow := fRowCount - 1; + result := true; + end; +end; + + +end. + Index: /oup/releases/0.18a/Unit1_main.dfm =================================================================== --- /oup/releases/0.18a/Unit1_main.dfm (revision 21) +++ /oup/releases/0.18a/Unit1_main.dfm (revision 21) @@ -0,0 +1,132 @@ +object Form1: TForm1 + Left = 0 + Top = 0 + HorzScrollBar.Visible = False + VertScrollBar.Visible = False + AutoScroll = False + Caption = 'Form1' + ClientHeight = 544 + ClientWidth = 692 + Color = clBtnFace + Font.Charset = DEFAULT_CHARSET + Font.Color = clWindowText + Font.Height = -11 + Font.Name = 'Tahoma' + Font.Style = [] + FormStyle = fsMDIForm + Menu = menu + OldCreateOrder = False + OnClose = FormClose + OnCreate = FormCreate + OnResize = FormResize + PixelsPerInch = 96 + TextHeight = 13 + object statbar: TStatusBar + Left = 0 + Top = 527 + Width = 692 + Height = 17 + BiDiMode = bdLeftToRight + Panels = < + item + Text = 'Current .dat: -' + Width = 500 + end + item + Text = 'Files: -' + Width = 90 + end + item + Text = 'Extensions: -' + Width = 100 + end> + ParentBiDiMode = False + end + object fopen: TOpenDialog + Filter = 'Oni-Dat-Files|*.dat|Oni-Sep-Files (MAC)|*.sep' + Left = 480 + end + object menu: TMainMenu + AutoHotkeys = maManual + Left = 592 + object menu_main: TMenuItem + Caption = '&Main' + object menu_loaddat: TMenuItem + Caption = '&Select .dat-file ...' + ShortCut = 16463 + OnClick = menu_loaddatClick + end + object menu_sep1: TMenuItem + Caption = '-' + end + object menu_exit: TMenuItem + Caption = '&Exit' + OnClick = menu_exitClick + end + end + object menu_extract: TMenuItem + Caption = '&Extract/Convert' + Enabled = False + Visible = False + object menu_extractfile: TMenuItem + Caption = 'Convert and extract current &file' + end + object menu_extractlist: TMenuItem + Caption = 'Convert and extract all files currently in &list' + end + object menu_extractall: TMenuItem + Caption = 'Convert and extract &all files' + end + end + object menu_tools: TMenuItem + Caption = '&Tools' + Enabled = False + object menu_preview: TMenuItem + Caption = '&Preview Window ...' + ShortCut = 16464 + OnClick = menu_previewClick + end + object menu_binedit: TMenuItem + Caption = '&Binary .dat editor ...' + ShortCut = 16450 + OnClick = menu_bineditClick + end + object menu_txmpreplace: TMenuItem + Caption = '&TXMP replacer ...' + ShortCut = 16468 + OnClick = menu_txmpreplaceClick + end + end + object menu_windows: TMenuItem + Caption = '&Windows' + object menu_windows_cascade: TMenuItem + Caption = 'Cascade' + OnClick = menu_windows_cascadeClick + end + object menu_windows_tile: TMenuItem + Caption = 'Tile' + OnClick = menu_windows_tileClick + end + object menu_windows_closeall: TMenuItem + Caption = '&Close all' + OnClick = menu_windows_closeallClick + end + object menu_sep3: TMenuItem + Caption = '-' + end + object menu_windows_next: TMenuItem + Caption = 'Next window' + ShortCut = 16417 + OnClick = menu_windows_nextClick + end + object menu_windows_previous: TMenuItem + Caption = 'Previous window' + ShortCut = 16418 + OnClick = menu_windows_previousClick + end + object menu_sep2: TMenuItem + Caption = '-' + end + end + end +end Index: /oup/releases/0.18a/Unit1_main.pas =================================================================== --- /oup/releases/0.18a/Unit1_main.pas (revision 21) +++ /oup/releases/0.18a/Unit1_main.pas (revision 21) @@ -0,0 +1,299 @@ +UNIT Unit1_main; +INTERFACE +USES + Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, + Dialogs, StdCtrls, StrUtils, Clipbrd, ExtCtrls, ComCtrls, Menus, + Unit2_functions, Unit3_data, Unit5_preview, Unit7_txmpreplace, Unit8_binedit, + Grids, MPHexEditor, ToolWin, ImgList, Tabs; + +TYPE + TForm1 = Class(TForm) + fopen: TOpenDialog; + menu: TMainMenu; + menu_main: TMenuItem; + menu_exit: TMenuItem; + menu_preview: TMenuItem; + menu_tools: TMenuItem; + menu_txmpreplace: TMenuItem; + menu_extract: TMenuItem; + menu_extractfile: TMenuItem; + menu_extractlist: TMenuItem; + menu_extractall: TMenuItem; + menu_loaddat: TMenuItem; + menu_sep1: TMenuItem; + menu_binedit: TMenuItem; + statbar: TStatusBar; + menu_windows: TMenuItem; + menu_windows_cascade: TMenuItem; + menu_windows_closeall: TMenuItem; + menu_sep2: TMenuItem; + menu_windows_tile: TMenuItem; + menu_sep3: TMenuItem; + menu_windows_next: TMenuItem; + menu_windows_previous: TMenuItem; + procedure menu_windows_previousClick(Sender: TObject); + procedure menu_windows_nextClick(Sender: TObject); + procedure menu_windows_tileClick(Sender: TObject); + PROCEDURE open_child(window_context:String); + PROCEDURE menu_windows_closeallClick(Sender: TObject); + PROCEDURE menu_windows_cascadeClick(Sender: TObject); + PROCEDURE menu_window_entryClick(Sender: TObject); + PROCEDURE menu_bineditClick(Sender: TObject); + PROCEDURE menu_loaddatClick(Sender: TObject); + PROCEDURE menu_txmpreplaceClick(Sender: TObject); + PROCEDURE menu_exitClick(Sender: TObject); + PROCEDURE menu_previewClick(Sender: TObject); + PROCEDURE FormClose(Sender: TObject; var Action: TCloseAction); + PROCEDURE FormResize(Sender: TObject); + PROCEDURE FormCreate(Sender: TObject); + PRIVATE + PUBLIC + END; + +VAR + Form1: TForm1; + +IMPLEMENTATION +{$R *.dfm} + +PROCEDURE LoadDat; + VAR i:LongWord; + BEGIN + Form1.fopen.InitialDir:=AppSettings.DatPath; + IF Form1.fopen.Execute THEN BEGIN + Form1.Caption:='Oni Un/Packer '+version+' ('+ExtractFileName(Form1.fopen.FileName)+')'; + AppSettings.DatPath:=ExtractFilepath(Form1.fopen.FileName); + IF LoadDatInfos(Form1.fopen.FileName) THEN BEGIN + Form1.statbar.Panels.Items[0].Text:='Current .dat: '+dat_FileName; + Form1.statbar.Panels.Items[1].Text:='Files: '+IntToStr(dat_header.Files); + Form1.statbar.Panels.Items[2].Text:='Extensions: '+IntToStr(dat_header.Extensions); + Form1.menu_tools.Enabled:=True; + Form1.menu_extract.Enabled:=True; + + IF Form1.MDIChildCount>0 THEN + FOR i:=0 TO Form1.MDIChildCount-1 DO BEGIN + IF Pos('binedit',Form1.MDIChildren[i].Name)>0 THEN + TForm8(Form1.MDIChildren[i]).Recreatelist; + IF Pos('preview',Form1.MDIChildren[i].Name)>0 THEN + TForm5(Form1.MDIChildren[i]).Recreatelist; + IF Pos('txmpreplace',Form1.MDIChildren[i].Name)>0 THEN + TForm7(Form1.MDIChildren[i]).Recreatelist; + END; + END ELSE BEGIN + ShowMessage('Error while loading the file:'+CrLf+Form1.fopen.FileName+CrLf+'Perhaps not an Oni-.dat-file?'); + END; + END; + END; + +PROCEDURE TForm1.FormCreate(Sender: TObject); + BEGIN + Form1.Caption:='Oni Un/Packer '+version; + Form1.FormResize(Form1); + + IF FileExists(ExtractFilepath(Application.EXEname)+'\oniunpacker.ini') THEN BEGIN + AssignFile(AppSettingsFile,ExtractFilepath(Application.EXEname)+'\oniunpacker.ini'); + Reset(AppSettingsFile); + Read(AppSettingsFile,AppSettings); + CloseFile(AppSettingsFile); + END ELSE BEGIN + AppSettings.DatPath:='D:\Spiele\Oni\GameDataFolder'; + AppSettings.ExtractPath:='C:\Dokumente und Einstellungen\Administrator\Desktop'; + END; + END; + +PROCEDURE TForm1.FormResize(Sender: TObject); + CONST + MinWidth:Integer=750; + MinHeight:Integer=500; + BEGIN + IF Form1.Width0 THEN BEGIN + FOR i:=0 TO MDIChildCount-1 DO BEGIN + MDIChildren[i].Close; + END; + END; + END; +PROCEDURE TForm1.menu_window_entryClick(Sender: TObject); + VAR + i:Byte; + window_name:String; + BEGIN + window_name:=MidStr(TComponent(Sender).Name,Pos('window_',TComponent(Sender).Name)+7,Length(TComponent(Sender).Name)-Pos('window_',TComponent(Sender).Name)+7+1); + FOR i:=0 TO MDIChildCount-1 DO BEGIN + IF MDIChildren[i].Name=window_name THEN BEGIN + MDIChildren[i].BringToFront; + END; + END; + END; + + + +PROCEDURE TForm1.open_child(window_context:String); + VAR + binEdit:TForm8; + preview:TForm5; + txmpreplacer:TForm7; + menu_button:TMenuItem; + used:Array[1..9] OF Boolean; + i,j:Byte; + caption:String; + name:String; + BEGIN + FOR i:=1 TO 9 DO used[i]:=False; + IF MDIChildCount>0 THEN + FOR i:=0 TO MDIChildCount-1 DO + IF Pos(window_context,Form1.MDIChildren[i].Name)=1 THEN + used[StrToInt(RightStr(Form1.MDIChildren[i].Caption,1))]:=True; + FOR i:=1 TO 10 DO + IF i=10 THEN + Break + ELSE + IF NOT used[i] THEN Break; + IF i<10 THEN BEGIN + name:=window_context+IntToStr(i); + IF window_context='binedit' THEN BEGIN + caption:='Binary .dat-Editor '+IntToStr(i); + binEdit:=TForm8.Create(Application); + binEdit.Name:=name; + binEdit.Caption:=caption; + binEdit.Recreatelist; + END; + IF window_context='preview' THEN BEGIN + caption:='Preview-Window '+IntToStr(i); + preview:=TForm5.Create(Application); + preview.Name:=name; + preview.Caption:=caption; + preview.Recreatelist; + END; + IF window_context='txmpreplace' THEN BEGIN + caption:='TXMP Replacer '+IntToStr(i); + txmpreplacer:=TForm7.Create(Application); + txmpreplacer.Name:=name; + txmpreplacer.Caption:=caption; + txmpreplacer.Recreatelist; + END; + + menu_button:=TMenuItem.Create(menu_windows); + menu_button.Caption:=caption; + menu_button.Name:='menu_window_'+name; + menu_button.OnClick:=Form1.menu_window_entryClick; + FOR j:=0 TO menu_windows.Count DO BEGIN + IF j0 THEN BEGIN + IF StrToInt(RightStr(menu_windows.Items[j].Name,1))>i THEN BEGIN + menu_windows.Insert(j,menu_button); + Break; + END; + END; + END ELSE BEGIN + menu_windows.Add(menu_button); + END; + END; + IF MDIChildCount=9 THEN menu_tools.Enabled:=False; + END; + END; + + +PROCEDURE TForm1.menu_windows_tileClick(Sender: TObject); + BEGIN + Form1.TileMode:=tbHorizontal; + Form1.Tile; + END; + +PROCEDURE TForm1.menu_windows_nextClick(Sender: TObject); + VAR i:Byte; + first_window:Byte; + current_focus:String; + BEGIN + IF MDIChildCount>1 THEN BEGIN + FOR i:=0 TO menu_windows.Count-1 DO BEGIN + IF Pos('menu_window_',menu_windows.Items[i].Name)=1 THEN BEGIN + first_window:=i; + Break; + END; + END; + current_focus:=ActiveMDIChild.Name; + FOR i:=first_window TO menu_windows.Count-1 DO + IF Pos(current_focus,menu_windows.Items[i].Name)>0 THEN + Break; + IF i=menu_windows.Count-1 THEN + menu_windows.Items[first_window].Click + ELSE + menu_windows.Items[i+1].Click; + END; + END; + +PROCEDURE TForm1.menu_windows_previousClick(Sender: TObject); + VAR i:Byte; + first_window:Byte; + current_focus:String; + BEGIN + IF MDIChildCount>1 THEN BEGIN + FOR i:=0 TO menu_windows.Count-1 DO BEGIN + IF Pos('menu_window_',menu_windows.Items[i].Name)=1 THEN BEGIN + first_window:=i; + Break; + END; + END; + current_focus:=ActiveMDIChild.Name; + FOR i:=first_window TO menu_windows.Count-1 DO + IF Pos(current_focus,menu_windows.Items[i].Name)>0 THEN + Break; + IF i=first_window THEN + menu_windows.Items[menu_windows.Count-1].Click + ELSE + menu_windows.Items[i-1].Click; + END; + END; + +END. Index: /oup/releases/0.18a/Unit2_functions.pas =================================================================== --- /oup/releases/0.18a/Unit2_functions.pas (revision 21) +++ /oup/releases/0.18a/Unit2_functions.pas (revision 21) @@ -0,0 +1,255 @@ +UNIT Unit2_functions; +INTERFACE +USES Classes, SysUtils, StrUtils, Math, SQLiteTable3, Unit3_data, Unit4_Exporters; + +FUNCTION Decode_Int(buffer:Tdata):LongWord; +FUNCTION Encode_Int(input:LongWord):Tdata; +FUNCTION Decode_Float(buffer:Tdata):Single; +FUNCTION Encode_Float(input:Single):Tdata; +FUNCTION LoadDatInfos(filename:String):Boolean; +FUNCTION LoadDatFile(fileid:LongWord):Tdata; +PROCEDURE SaveDatFile(fileid:LongWord; data:Tdata); +FUNCTION LoadDatFilePart(fileid,offset,size:LongWord; target:Pointer):Boolean; +FUNCTION LoadRawFilePart(address,size:LongWord; target:Pointer):Boolean; +FUNCTION FormatNumber(value:LongWord; width:Byte; leadingzeros:Char):String; +FUNCTION FormatFileSize(size:LongWord):String; +FUNCTION CreateHexString(data:Tdata; HexOnly:Boolean):String; +FUNCTION ExportFile(fileid:LongWord; convert:Boolean):Integer; +FUNCTION GetWinFileName(fileid:LongWord; substring:String):String; +FUNCTION GetExtractPath:String; + + + +IMPLEMENTATION + +TYPE + TValueSwitcher=Record + CASE IsFloat: Boolean OF + True: (ValueFloat:Single); + False: (ValueInt:LongWord); + END; + + +FUNCTION Decode_Int(buffer:Tdata):LongWord; + BEGIN + Result:=buffer[0]+buffer[1]*256+buffer[2]*256*256+buffer[3]*256*256*256; + END; +FUNCTION Encode_Int(input:LongWord):Tdata; + BEGIN + Result[0]:=input MOD 256; + input:=input DIV 256; + Result[1]:=input MOD 256; + input:=input DIV 256; + Result[2]:=input MOD 256; + input:=input DIV 256; + Result[3]:=input MOD 256; + END; +FUNCTION Decode_Float(buffer:Tdata):Single; + VAR _valueswitcher:TValueSwitcher; + BEGIN + _valueswitcher.ValueInt:=Decode_Int(buffer); + Result:=_valueswitcher.ValueFloat; + END; +FUNCTION Encode_Float(input:Single):Tdata; + VAR _valueswitcher:TValueSwitcher; + BEGIN + _valueswitcher.ValueFloat:=input; + Result:=Encode_Int(_valueswitcher.ValueInt); + END; + + +FUNCTION LoadDatInfos(filename:String):Boolean; + VAR i:LongWord; + dat_file:TFileStream; + BEGIN + Result:=True; + dat_filename:=filename; + raw_filename:=MidStr(filename,1,Length(filename)-3)+'raw'; + dat_file:=TFileStream.Create(filename, fmOpenRead); + dat_file.Read(dat_header,SizeOf(dat_header)); + FOR i:=0 TO High(dat_header.Ident) DO + IF dat_header.Ident[i]<>header_ident1[i] THEN BEGIN + Result:=False; + Exit; + END; +{ FOR i:=0 TO High(dat_header.Ident2) DO + IF dat_header.Ident2[i]<>header_ident2[i] THEN BEGIN + Result:=False; + Exit; + END; +} + SetLength(dat_filesmap,dat_header.Files); + SetLength(dat_files,dat_header.Files); + FOR i:=0 TO dat_header.Files-1 DO dat_file.Read(dat_filesmap[i],SizeOf(dat_filesmap[i])); + FOR i:=0 TO dat_header.Files-1 DO BEGIN + dat_files[i].Extension:=dat_filesmap[i].Extension; + dat_files[i].Extension:=ReverseString(dat_files[i].Extension); + dat_files[i].Size:=dat_filesmap[i].FileSize; + dat_files[i].FileType:=dat_filesmap[i].FileType; + dat_files[i].DatAddr:=dat_filesmap[i].DataAddr-8+dat_header.DataAddr; + IF (dat_filesmap[i].FileType AND $01)=0 THEN BEGIN + dat_file.Seek(dat_filesmap[i].NameAddr+dat_header.NamesAddr,soFromBeginning); + SetLength(dat_files[i].Name,100); + dat_file.Read(dat_files[i].Name[1],100); + dat_files[i].Name:=MidStr(dat_files[i].Name,1+4,Pos(#0,dat_files[i].Name)-1-4); + END ELSE BEGIN + dat_files[i].Name:=''; + END; + dat_files[i].FileName:=FormatNumber(i,5,'0')+'-'+dat_files[i].Name+'.'+dat_files[i].Extension; + END; + dat_file.Seek($40+dat_header.Files*$14,soFromBeginning); + SetLength(dat_namedfilesmap,dat_header.NamedFiles); + FOR i:=0 TO dat_header.NamedFiles-1 DO dat_file.Read(dat_namedfilesmap[i],SizeOf(dat_namedfilesmap[i])); + + dat_file.Seek($40+dat_header.Files*$14+dat_header.NamedFiles*$8,soFromBeginning); + SetLength(dat_extensionsmap,dat_header.Extensions); + FOR i:=0 TO dat_header.Extensions-1 DO dat_file.Read(dat_extensionsmap[i],SizeOf(dat_extensionsmap[i])); + + dat_file.Free; + END; + + +FUNCTION LoadDatFile(fileid:LongWord):Tdata; + VAR dat_file:TFileStream; + BEGIN + dat_file:=TFileStream.Create(dat_filename, fmOpenRead); + dat_file.Seek(dat_files[fileid].DatAddr,soFromBeginning); + SetLength(Result,dat_files[fileid].Size); + dat_file.Read(Result[0],dat_files[fileid].Size); + dat_file.Free; + END; + + +PROCEDURE SaveDatFile(fileid:LongWord; data:Tdata); + VAR dat_file:TFileStream; + BEGIN + dat_file:=TFileStream.Create(dat_filename, fmOpenReadWrite); + dat_file.Seek(dat_files[fileid].DatAddr,soFromBeginning); + dat_file.Write(data[0],Length(data)); + dat_file.Free; + END; + + +FUNCTION LoadDatFilePart(fileid,offset,size:LongWord; target:Pointer):Boolean; + VAR dat_file:TFileStream; + BEGIN + dat_file:=TFileStream.Create(dat_filename, fmOpenRead); + Result:=True; + dat_file.Seek(dat_files[fileid].DatAddr+offset,soFromBeginning); + dat_file.Read(target^,size); + dat_file.Free; + END; + + +FUNCTION LoadRawFilePart(address,size:LongWord; target:Pointer):Boolean; + VAR + filestream:TFileStream; + BEGIN + Result:=True; + filestream:=TFileStream.Create(AnsiReplaceStr(dat_filename,'.dat','.raw'),fmOpenRead); + filestream.Seek(address,soFromBeginning); + filestream.Read(target^,size); + filestream.Free; + END; + + +FUNCTION FormatNumber(value:LongWord; width:Byte; leadingzeros:Char):String; + BEGIN + Result:=AnsiReplaceStr(Format('%'+IntToStr(width)+'u',[value]),' ',leadingzeros); + END; + + +FUNCTION FormatFileSize(size:LongWord):String; + BEGIN + IF size>=1000*1024*1024 THEN BEGIN + Result:=FloatToStrF(size/1024/1024/1024,ffFixed,5,1)+' GB'; + END ELSE BEGIN + IF size>=1000*1024 THEN BEGIN + Result:=FloatToStrF(size/1024/1024,ffFixed,5,1)+' MB'; + END ELSE BEGIN + IF size>=1000 THEN BEGIN + Result:=FloatToStrF(size/1024,ffFixed,5,1)+' KB'; + END ELSE BEGIN + Result:=IntToStr(size)+' B'; + END; + END; + END; + END; + + +FUNCTION CreateHexString(data:Tdata; HexOnly:Boolean):String; + VAR + string_build,ascii_version:String; + i:LongWord; + BEGIN + string_build:=''; + ascii_version:=''; + FOR i:=0 TO High(data) DO BEGIN + IF NOT HexOnly THEN + IF (i MOD 16)=0 THEN + string_build:=string_build+'0x'+IntToHex(i,6)+' '; + string_build:=string_build+IntToHex(data[i],2); + IF NOT HexOnly THEN BEGIN + IF data[i]>=32 THEN ascii_version:=ascii_version+Chr(data[i]) + ELSE ascii_version:=ascii_version+'.'; + IF ((i+1) MOD 2)=0 THEN string_build:=string_build+#32; + IF ((i+1) MOD 16)=0 THEN BEGIN + string_build:=string_build+#32+ascii_version+CrLf; + ascii_version:=''; + END; + END; + END; + Result:=string_build; + END; + + +FUNCTION ExportFile(fileid:LongWord; convert:Boolean):Integer; + VAR + i:Byte; + BEGIN + Result:=export_noerror; + + //ExportDefFileHeader(fileid); + + IF (dat_files[fileid].FileType AND $02)=0 THEN BEGIN + //ExportDatFile(fileid); + + FOR i:=1 TO Length(ExportHandlers)+1 DO BEGIN + IF i<=Length(ExportHandlers) THEN BEGIN + IF ExportHandlers[i].Ext=dat_files[fileid].Extension THEN BEGIN + IF ExportHandlers[i].needed THEN BEGIN + CASE ExportHandlers[i].Handler(fileid,convert) OF + 0: Result:=0; + ELSE + Result:=export_handlererror; + END; + END; + Break; + END; + END ELSE BEGIN + Result:=export_nohandler; + END; + END; + END; + END; + + +FUNCTION GetWinFileName(fileid:LongWord; substring:String):String; + VAR + name:String; + BEGIN + name:=dat_files[fileid].Name; + name:=AnsiReplaceStr(name,'\','__'); + name:=AnsiReplaceStr(name,'/','__'); + name:=AnsiReplaceStr(name,'>','__'); + name:=AnsiReplaceStr(name,'<','__'); + Result:=FormatNumber(fileid,5,'0')+'-'+name+'.'+substring+'.'+dat_files[fileid].Extension; + END; + +FUNCTION GetExtractPath:String; + BEGIN + Result:=ExtractFilePath(dat_filename)+'\extracted_'+ExtractFileName(dat_filename); + END; + + +END. Index: /oup/releases/0.18a/Unit3_data.pas =================================================================== --- /oup/releases/0.18a/Unit3_data.pas (revision 21) +++ /oup/releases/0.18a/Unit3_data.pas (revision 21) @@ -0,0 +1,85 @@ +UNIT Unit3_data; +INTERFACE +USES Classes; + +CONST + version:String='v0.18a'; + CrLf:String[2]=#13+#10; + +TYPE + Tdata=Array OF Byte; + Theader=PACKED RECORD + Ident:Array[0..$13] OF Byte; + Files:LongWord; + NamedFiles:LongWord; + Extensions:LongWord; + DataAddr:LongWord; + DataSize:LongWord; + NamesAddr:LongWord; + NamesSize:LongWord; + Ident2:Array[0..$F] OF Byte; + END; + Tfilesmap=Array OF PACKED RECORD + Extension:Array[0..$3] OF Char; + DataAddr:LongWord; + NameAddr:LongWord; + FileSize:LongWord; + FileType:LongWord; + END; + Tfiles=Array OF PACKED RECORD + FileName:String; + Extension:String[4]; + Name:String; + Size:LongWord; + FileType:LongWord; + DatAddr:LongWord; + opened:Boolean; + END; + + Tnamedfilesmap=Array OF PACKED RECORD + FileNumber:LongWord; + blubb:LongWord; + END; + Textensionsmap=Array OF PACKED RECORD + Ident:Array[0..$7] OF Byte; + Extension:Array[0..$3] OF Char; + ExtCount:LongWord; + END; + + TAppSettings=RECORD + DatPath:String[250]; + ExtractPath:String[250]; + END; + + TExportHandlers=RECORD + Ext:String[4]; + needed:Boolean; + Handler:Function(fileid:LongWord; convert:Boolean):Integer; + END; + +VAR + dat_filename:String=''; + raw_filename:String=''; + dat_header:Theader; + dat_filesmap:Tfilesmap; + dat_files:Tfiles; + dat_namedfilesmap:Tnamedfilesmap; + dat_extensionsmap:Textensionsmap; + AppSettings:TAppSettings; + AppSettingsFile:File OF TAppSettings; + +CONST + header_ident1:Array[0..$13] OF Byte= + ($1F,$27,$DC,$33,$DF,$BC,$03,$00,$31,$33,$52,$56,$40,$00,$14,$00,$10,$00,$08,$00); + header_ident2:Array[0..$F] OF Byte= + ($99,$CF,$40,$00,$90,$4F,$63,$00,$F4,$55,$5F,$00,$90,$4F,$63,$00); + + export_noerror:Integer=0; + export_nohandler:Integer=1; + export_handlererror:Integer=2; + export_error:Integer=3; + +IMPLEMENTATION + +END. + Index: /oup/releases/0.18a/Unit4_Exporters.pas =================================================================== --- /oup/releases/0.18a/Unit4_Exporters.pas (revision 21) +++ /oup/releases/0.18a/Unit4_Exporters.pas (revision 21) @@ -0,0 +1,181 @@ +UNIT Unit4_Exporters; +INTERFACE +USES Classes, StrUtils, SysUtils, Math, Unit3_data, Unit6_imgfuncs; + +PROCEDURE ExportDefLine(fileid:LongWord; line:String; create:Boolean); +PROCEDURE ExportDefFileHeader(fileid:LongWord); +PROCEDURE ExportDatFile(fileid:LongWord; filename:String); + +FUNCTION ExportTRAC(fileid:LongWord; convert:Boolean):Integer; +FUNCTION ExportTXAN(fileid:LongWord; convert:Boolean):Integer; +FUNCTION ExportTXMB(fileid:LongWord; convert:Boolean):Integer; +FUNCTION ExportTXMP(fileid:LongWord; convert:Boolean):Integer; +VAR + ExportHandlers:Array[1..5] OF TExportHandlers=( + (Ext:'ABNA'; needed:False), + //(Ext:'AGDB'; needed:False), + (Ext:'TRAC'; needed:True; Handler:ExportTRAC), + (Ext:'TXAN'; needed:True; Handler:ExportTXAN), + (Ext:'TXMB'; needed:True; Handler:ExportTXMB), + (Ext:'TXMP'; needed:True; Handler:ExportTXMP) + ); + + + +IMPLEMENTATION +USES Unit2_functions; + +PROCEDURE ExportDefLine(fileid:LongWord; line:String; create:Boolean); + VAR + filestream:TFileStream; + data:Tdata; + i:LongWord; + BEGIN + SetLength(data,Length(line)+2); + FOR i:=1 TO Length(line) DO + data[i-1]:=Ord(line[i]); + data[Length(line)]:=13; + data[Length(line)+1]:=10; + { + IF create THEN + filestream:=TFileStream.Create(GetExtractPath+'\'+GetWinFileName(fileid,'_DEF_'),fmCreate) + ELSE BEGIN + filestream:=TFileStream.Create(GetExtractPath+'\'+GetWinFileName(fileid,'_DEF_'),fmOpenWrite); + filestream.Seek(0,soFromEnd); + END; + filestream.Write(data[0],Length(data)); + filestream.Free; + } + END; + +PROCEDURE ExportDefFileHeader(fileid:LongWord); + BEGIN + IF NOT DirectoryExists(GetExtractPath) THEN + CreateDir(GetExtractPath); + WITH dat_files[fileid] DO + ExportDefLine(fileid,FormatNumber(fileid,5,'0')+':'+Name+':'+Extension+':'+IntToHex(Size,8)+':'+IntToHex(FileType,8),True); + END; + +PROCEDURE ExportDatFile(fileid:LongWord; filename:String); + VAR + filestream:TFileStream; + data:Tdata; + BEGIN + data:=LoadDatFile(fileid); + filestream:=TFileStream.Create(filename,fmCreate); + filestream.Write(data[0],Length(data)); + filestream.Free; + END; + + +FUNCTION ExportTRAC; + VAR + link:LongWord; + linkcount:Word; + i:LongWord; + BEGIN + Result:=export_noerror; + + LoadDatFilePart(fileid,$18,SizeOf(link),@link); + link:=link DIV 256; + ExportDefLine(fileid,FormatNumber(0,4,'0')+':LINKtoTRAC:'+FormatNumber(link,5,'0')+':'+dat_files[link].Name+':'+dat_files[link].Extension,False); + + LoadDatFilePart(fileid,$1E,SizeOf(linkcount),@linkcount); + ExportDefLine(fileid,'TRAMLINKS:'+FormatNumber(linkcount,4,'0'),False); + FOR i:=1 TO linkcount DO BEGIN + LoadDatFilePart(fileid,$20+(i-1)*12+8,SizeOf(link),@link); + link:=link DIV 256; + ExportDefLine(fileid,FormatNumber(i,4,'0')+':LINKtoTRAM:'+FormatNumber(link,5,'0')+':'+dat_files[link].Name+':'+dat_files[link].Extension,False); + END; + END; + +FUNCTION ExportTXAN; + VAR + loop_speed,unknown:Word; + linkcount:LongWord; + link:LongWord; + i:Byte; + BEGIN + Result:=export_noerror; + + LoadDatFilePart(fileid,$14,SizeOf(loop_speed),@loop_speed); + LoadDatFilePart(fileid,$16,SizeOf(unknown),@unknown); + ExportDefLine(fileid,'LOOPSPEED:'+FormatNumber(loop_speed,2,'0'),False); + ExportDefLine(fileid,'UNKNOWN:'+FormatNumber(unknown,2,'0'),False); + + LoadDatFilePart(fileid,$1C,SizeOf(linkcount),@linkcount); + ExportDefLine(fileid,'TXMPLINKS:'+FormatNumber(linkcount,4,'0'),False); + FOR i:=0 TO linkcount-1 DO BEGIN + LoadDatFilePart(fileid,$20+i*4,SizeOf(link),@link); + link:=link DIV 256; + IF link=0 THEN link:=fileid-1; + ExportDefLine(fileid,FormatNumber(i,4,'0')+':LINKtoTXMP:'+FormatNumber(link,5,'0')+':'+dat_files[link].Name+':'+dat_files[link].Extension,False); + END; + END; + +FUNCTION ExportTXMB; + VAR + filestream:TFileStream; + subfile:Byte; + linkcount:LongWord; + link:LongWord; + width,height:Word; + cols,rows:Word; + i:Byte; + img:TImgPackage; + data:Tdata; + BEGIN + Result:=export_noerror; + subfile:=1; + + LoadDatFilePart(fileid,$10,SizeOf(width),@width); + LoadDatFilePart(fileid,$12,SizeOf(height),@height); + LoadDatFilePart(fileid,$18,SizeOf(cols),@cols); + LoadDatFilePart(fileid,$1A,SizeOf(rows),@rows); + ExportDefLine(fileid,'WIDTH:'+FormatNumber(width,4,'0'),False); + ExportDefLine(fileid,'HEIGHT:'+FormatNumber(height,4,'0'),False); + ExportDefLine(fileid,'COLS:'+FormatNumber(cols,2,'0'),False); + ExportDefLine(fileid,'ROWS:'+FormatNumber(rows,2,'0'),False); + + LoadDatFilePart(fileid,$1C,SizeOf(linkcount),@linkcount); + ExportDefLine(fileid,'TXMPLINKS:'+FormatNumber(linkcount,4,'0'),False); + FOR i:=0 TO linkcount-1 DO BEGIN + LoadDatFilePart(fileid,$20+i*4,SizeOf(link),@link); + link:=link DIV 256; + IF link=0 THEN link:=fileid-1; + ExportDefLine(fileid,FormatNumber(i,4,'0')+':LINKtoTXMP:'+FormatNumber(link,5,'0')+':'+dat_files[link].Name+':'+dat_files[link].Extension,False); + END; + + IF convert THEN BEGIN + img:=LoadTXMBconnected(fileid); + data:=ImgdataToBmp(img.imgx,img.imgy,img.imgdepth,img.storetype,img.imgdata); + filestream:=TFileStream.Create(GetExtractPath+'\'+GetWinFileName(fileid,FormatNumber(subfile,2,'0')+'-ImgData')+'.bmp',fmCreate); + filestream.Write(data[0],Length(data)); + filestream.Free; + END; + END; + +FUNCTION ExportTXMP; + VAR + filestream:TFileStream; + subfile:Byte; + img:TImgPackage; + BEGIN + Result:=export_noerror; + subfile:=1; + + img:=LoadImgData(fileid); + { + filestream:=TFileStream.Create(GetExtractPath+'\'+GetWinFileName(fileid,FormatNumber(subfile,2,'0')+'-ImgData'),fmCreate); + filestream.Write(img.imgdata[0],Length(img.imgdata)); + filestream.Free; + } + IF convert THEN BEGIN + img.imgdata:=ImgdataToBMP(img.imgx,img.imgy,img.imgdepth,img.storetype,img.imgdata); + filestream:=TFileStream.Create(GetExtractPath+'\'+GetWinFileName(fileid,FormatNumber(subfile,2,'0')+'-ImgData')+'.bmp',fmCreate); + filestream.Write(img.imgdata[0],Length(img.imgdata)); + filestream.Free; + END; + END; + +END. Index: /oup/releases/0.18a/Unit5_preview.dfm =================================================================== --- /oup/releases/0.18a/Unit5_preview.dfm (revision 21) +++ /oup/releases/0.18a/Unit5_preview.dfm (revision 21) @@ -0,0 +1,155 @@ +object Form5: TForm5 + Left = 0 + Top = 0 + Width = 300 + Height = 200 + Caption = 'Preview' + Color = clBtnFace + Font.Charset = DEFAULT_CHARSET + Font.Color = clWindowText + Font.Height = -11 + Font.Name = 'Tahoma' + Font.Style = [] + FormStyle = fsMDIChild + OldCreateOrder = False + Visible = True + OnClose = FormClose + OnCreate = FormCreate + OnResize = FormResize + PixelsPerInch = 96 + TextHeight = 13 + object Splitter1: TSplitter + Left = 150 + Top = 0 + Width = 9 + Height = 173 + AutoSnap = False + Beveled = True + MinSize = 150 + end + object panel_preview: TPanel + Left = 159 + Top = 0 + Width = 133 + Height = 173 + Align = alClient + BevelOuter = bvNone + TabOrder = 0 + object img: TImage + Left = 0 + Top = 20 + Width = 133 + Height = 153 + Align = alClient + end + object lbl_notpossible: TLabel + Left = 16 + Top = 56 + Width = 97 + Height = 65 + AutoSize = False + Caption = 'No preview possible for this filetype' + Font.Charset = DEFAULT_CHARSET + Font.Color = clWindowText + Font.Height = -16 + Font.Name = 'Tahoma' + Font.Style = [] + ParentFont = False + Visible = False + WordWrap = True + end + object panel_buttons: TPanel + Left = 0 + Top = 0 + Width = 133 + Height = 20 + Align = alTop + BevelOuter = bvNone + TabOrder = 0 + Visible = False + OnResize = panel_buttonsResize + object btn_dec: TButton + Left = 0 + Top = 0 + Width = 20 + Height = 20 + Caption = '-' + Enabled = False + TabOrder = 0 + OnClick = btn_decClick + end + object btn_startstop: TButton + Left = 21 + Top = 0 + Width = 80 + Height = 20 + Caption = 'Stop automatic' + TabOrder = 1 + OnClick = btn_startstopClick + end + object btn_inc: TButton + Left = 102 + Top = 0 + Width = 20 + Height = 20 + Caption = '+' + Enabled = False + TabOrder = 2 + OnClick = btn_incClick + end + end + end + object panel_files: TPanel + Left = 0 + Top = 0 + Width = 150 + Height = 173 + Align = alLeft + BevelOuter = bvNone + TabOrder = 1 + object list: TListBox + Left = 0 + Top = 0 + Width = 150 + Height = 148 + Align = alClient + ItemHeight = 13 + TabOrder = 0 + OnClick = listClick + end + object panel_extension: TPanel + Left = 0 + Top = 148 + Width = 150 + Height = 25 + Align = alBottom + BevelOuter = bvNone + TabOrder = 1 + OnResize = panel_extensionResize + object combo_extension: TComboBox + Left = 2 + Top = 2 + Width = 145 + Height = 21 + Style = csDropDownList + DropDownCount = 12 + Font.Charset = DEFAULT_CHARSET + Font.Color = clWindowText + Font.Height = -11 + Font.Name = 'Tahoma' + Font.Style = [] + ItemHeight = 13 + ParentFont = False + Sorted = True + TabOrder = 0 + OnClick = combo_extensionClick + end + end + end + object timer: TTimer + Enabled = False + OnTimer = timerTimer + Left = 144 + Top = 24 + end +end Index: /oup/releases/0.18a/Unit5_preview.pas =================================================================== --- /oup/releases/0.18a/Unit5_preview.pas (revision 21) +++ /oup/releases/0.18a/Unit5_preview.pas (revision 21) @@ -0,0 +1,261 @@ +UNIT Unit5_preview; +INTERFACE +USES + Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, + Dialogs, Math, ExtCtrls, Unit2_functions, Unit3_data, Unit4_exporters, Unit6_imgfuncs, + StdCtrls, StrUtils; + +TYPE + TForm5 = Class(TForm) + timer: TTimer; + panel_preview: TPanel; + img: TImage; + panel_buttons: TPanel; + btn_dec: TButton; + btn_startstop: TButton; + btn_inc: TButton; + panel_files: TPanel; + list: TListBox; + panel_extension: TPanel; + combo_extension: TComboBox; + Splitter1: TSplitter; + lbl_notpossible: TLabel; + PROCEDURE Recreatelist; + PROCEDURE listClick(Sender: TObject); + PROCEDURE PreviewTXAN; + PROCEDURE PreviewTXMB; + PROCEDURE PreviewTXMP; + PROCEDURE panel_extensionResize(Sender: TObject); + PROCEDURE combo_extensionClick(Sender: TObject); + PROCEDURE btn_incClick(Sender: TObject); + PROCEDURE btn_decClick(Sender: TObject); + PROCEDURE FormResize(Sender: TObject); + PROCEDURE btn_startstopClick(Sender: TObject); + PROCEDURE panel_buttonsResize(Sender: TObject); + PROCEDURE timerTimer(Sender: TObject); + PROCEDURE FormCreate(Sender: TObject); + PROCEDURE FormClose(Sender: TObject; var Action: TCloseAction); + PRIVATE + PUBLIC + END; + +VAR + Form5: TForm5; + +IMPLEMENTATION +{$R *.dfm} +USES Unit1_main; +VAR + memstreams:Array OF TMemoryStream; + actualimg:Byte; + _fileid:LongWord; + + +PROCEDURE TForm5.Recreatelist; + VAR + i:LongWord; + BEGIN + combo_extension.Items.Clear; + combo_extension.Items.Add('_All files_ ('+IntToStr(dat_header.Files)+')'); + FOR i:=0 TO dat_header.Extensions-1 DO BEGIN + WITH dat_extensionsmap[i] DO BEGIN + combo_extension.Items.Add( + Extension[3]+Extension[2]+Extension[1]+Extension[0]+' ('+ + IntToStr(ExtCount)+')'); + END; + END; + combo_extension.ItemIndex:=0; + combo_extensionClick(Self); + END; + + +PROCEDURE TForm5.listClick(Sender: TObject); + BEGIN + _fileid:=StrToInt(MidStr(list.Items.Strings[list.ItemIndex],1,5)); + lbl_notpossible.Visible:=False; + Self.img.Visible:=True; + Self.timer.Enabled:=False; + Self.panel_buttons.Visible:=False; + Self.Caption:='Preview '+dat_files[_fileid].FileName; + IF dat_files[_fileid].Extension='TXAN' THEN PreviewTXAN + ELSE + IF dat_files[_fileid].Extension='TXMB' THEN PreviewTXMB + ELSE + IF dat_files[_fileid].Extension='TXMP' THEN PreviewTXMP + ELSE BEGIN + Self.lbl_notpossible.Visible:=True; + Self.img.Visible:=False; + END; + END; + + +PROCEDURE TForm5.panel_extensionResize(Sender: TObject); + BEGIN + combo_extension.Width:=panel_extension.Width-5; + END; + + +PROCEDURE TForm5.combo_extensionClick(Sender: TObject); + VAR + Extension:String[4]; + i:LongWord; + BEGIN + Extension:=MidStr(combo_extension.Items.Strings[combo_extension.ItemIndex],1,4); + list.Items.Clear; + IF Extension='_All' THEN BEGIN + FOR i:=0 TO dat_header.Files-1 DO + IF (dat_files[i].FileType AND $02)=0 THEN + list.Items.Add(dat_files[i].FileName); + END ELSE BEGIN + FOR i:=0 TO dat_header.Files-1 DO + IF dat_files[i].Extension=Extension THEN + IF (dat_files[i].FileType AND $02)=0 THEN + list.Items.Add(dat_files[i].FileName); + END; + END; + + +PROCEDURE TForm5.PreviewTXMB; + VAR + data:Tdata; + img:TImgPackage; + BEGIN + SetLength(memstreams,1); + img:=LoadTXMBconnected(_fileid); + data:=ImgdataToBmp(img.imgx,img.imgy,img.imgdepth,img.storetype,img.imgdata); + + memstreams[0].Clear; + memstreams[0].Write(data[0],Length(data)); + memstreams[0].Seek(0,soFromBeginning); + + Self.img.Picture.Bitmap.LoadFromStream(memstreams[0]); + END; + +PROCEDURE TForm5.PreviewTXMP; + VAR + data:Tdata; + img:TImgPackage; + BEGIN + SetLength(memstreams,1); + img:=LoadImgData(_fileid); + data:=ImgdataToBmp(img.imgx,img.imgy,img.imgdepth,img.storetype,img.imgdata); + + memstreams[0].Clear; + memstreams[0].Write(data[0],Length(data)); + memstreams[0].Seek(0,soFromBeginning); + + Self.img.Picture.Bitmap.LoadFromStream(memstreams[0]); + END; + +PROCEDURE TForm5.PreviewTXAN; + VAR + loop_speed:Word; + linkcount:LongWord; + link:LongWord; + i:Byte; + data:Tdata; + img:TImgPackage; + BEGIN + LoadDatFilePart(_fileid,$14,SizeOf(loop_speed),@loop_speed); + LoadDatFilePart(_fileid,$1C,SizeOf(linkcount),@linkcount); + SetLength(memstreams,linkcount); + FOR i:=0 TO linkcount-1 DO BEGIN + LoadDatFilePart(_fileid,$20+i*4,SizeOf(link),@link); + link:=link DIV 256; + IF link=0 THEN link:=_fileid-1; + memstreams[i]:=TMemoryStream.Create; + img:=LoadImgData(link); + data:=ImgdataToBmp(img.imgx,img.imgy,img.imgdepth,img.storetype,img.imgdata); + memstreams[i].Clear; + memstreams[i].Write(data[0],Length(data)); + memstreams[i].Seek(0,soFromBeginning); + END; + actualimg:=254; + Self.timer.Interval:=Floor(loop_speed*(1/60)*1000); + Self.timer.Enabled:=False; + Self.btn_startstopClick(Self); + Self.panel_buttons.Visible:=True; + END; + + +PROCEDURE TForm5.FormCreate(Sender: TObject); + BEGIN + SetLength(memstreams,1); + memstreams[0]:=TMemoryStream.Create; + Self.Width:=260; + Self.Height:=300; + END; + +PROCEDURE TForm5.timerTimer(Sender: TObject); + BEGIN + Inc(actualimg); + IF actualimg>=Length(memstreams) THEN actualimg:=0; + Self.img.Picture.Bitmap.LoadFromStream(memstreams[actualimg]); + memstreams[actualimg].Seek(0,soFromBeginning); + Self.Caption:='Preview '+dat_files[_fileid].FileName+' ('+IntToStr(actualimg+1)+'/'+IntToStr(Length(memstreams))+')'; + END; + +PROCEDURE TForm5.panel_buttonsResize(Sender: TObject); + BEGIN + btn_startstop.Width:=panel_buttons.Width-45; + btn_inc.Left:=panel_buttons.Width-23; + END; + +PROCEDURE TForm5.btn_startstopClick(Sender: TObject); + BEGIN + Self.timer.Enabled:=NOT Self.timer.Enabled; + Self.btn_dec.Enabled:=NOT Self.timer.Enabled; + Self.btn_inc.Enabled:=NOT Self.timer.Enabled; + IF Self.timer.Enabled THEN + Self.btn_startstop.Caption:='Stop automatic' + ELSE + Self.btn_startstop.Caption:='Start automatic'; + END; + +PROCEDURE TForm5.FormResize(Sender: TObject); + BEGIN + IF Self.Width>=300 THEN BEGIN + END ELSE Self.Width:=300; + IF Self.Height>=200 THEN BEGIN + END ELSE Self.Height:=200; + END; + +PROCEDURE TForm5.btn_decClick(Sender: TObject); + BEGIN + IF actualimg>0 THEN + Dec(actualimg) + ELSE + actualimg:=High(memstreams); + Self.Caption:='Preview '+dat_files[_fileid].FileName+' ('+IntToStr(actualimg+1)+'/'+IntToStr(Length(memstreams))+')'; + Self.img.Picture.Bitmap.LoadFromStream(memstreams[actualimg]); + memstreams[actualimg].Seek(0,soFromBeginning); + END; + +PROCEDURE TForm5.btn_incClick(Sender: TObject); + BEGIN + IF actualimg0) THEN BEGIN + Inc(row_orig); + IF (row_orig MOD 2)=0 THEN BEGIN + Inc(row); + col:=0; + END; + END; + IF (row_orig MOD 2)=0 THEN BEGIN + IF (i MOD 2)=0 THEN BEGIN + FOR j:=0 TO (imgdepth DIV 8)-1 DO + temparray[((row*(oldx DIV 2))+col)*(imgdepth DIV 8)+j]:=data[i*2+j]; + Inc(col); + END; + END; + END; + Result:=temparray; + END; + + +FUNCTION RevertImage(imgx,imgy,imgdepth:LongWord; imgdata:Tdata):Tdata; + VAR + x,y,i:LongWord; + BEGIN + SetLength(Result,imgx*imgy*(imgdepth DIV 8)); + FOR y:=0 TO imgy-1 DO + FOR x:=0 TO imgx-1 DO + FOR i:=0 TO (imgdepth DIV 8)-1 DO + Result[((imgx*(imgy-1-y)+x)*(imgdepth DIV 8))+i]:= + imgdata[(imgx*y+x)*(imgdepth DIV 8)+i]; + END; + + +FUNCTION DecompressImage(imgx,imgy:LongWord; imgdata:Tdata):Tdata; + TYPE + Tcolor=RECORD + RGBb:Byte; + RGBg:Byte; + RGBr:Byte; + RGBa:Byte; + END; + VAR + i,j,x,y:LongWord; + color:Array[1..4] OF Tcolor; + pixel:Array[1..16] OF Byte; + BEGIN + x:=0; + y:=0; + SetLength(Result,imgx*imgy*4); + FOR i:=0 TO ((imgx*imgy) DIV 16)-1 DO BEGIN + Color[1].RGBb:=Floor(((imgdata[(i*8)+0]+imgdata[(i*8)+1]*256) AND $001F) / $001F * 255); + Color[1].RGBg:=Floor(((imgdata[(i*8)+0]+imgdata[(i*8)+1]*256) AND $07E0) / $07E0 * 255); + Color[1].RGBr:=Floor(((imgdata[(i*8)+0]+imgdata[(i*8)+1]*256) AND $F800) / $F800 * 255); + Color[1].RGBa:=255; + Color[2].RGBb:=Floor(((imgdata[(i*8)+2]+imgdata[(i*8)+3]*256) AND $001F) / $001F * 255); + Color[2].RGBg:=Floor(((imgdata[(i*8)+2]+imgdata[(i*8)+3]*256) AND $07E0) / $07E0 * 255); + Color[2].RGBr:=Floor(((imgdata[(i*8)+2]+imgdata[(i*8)+3]*256) AND $F800) / $F800 * 255); + Color[2].RGBa:=255; + Color[3].RGBb:=Floor( Color[1].RGBb/3*2 + Color[2].RGBb/3 ); + Color[3].RGBg:=Floor( Color[1].RGBg/3*2 + Color[2].RGBg/3 ); + Color[3].RGBr:=Floor( Color[1].RGBr/3*2 + Color[2].RGBr/3 ); + Color[3].RGBa:=255; + Color[4].RGBb:=Floor( Color[1].RGBb/3 + Color[2].RGBb/3*2 ); + Color[4].RGBg:=Floor( Color[1].RGBg/3 + Color[2].RGBg/3*2 ); + Color[4].RGBr:=Floor( Color[1].RGBr/3 + Color[2].RGBr/3*2 ); + Color[4].RGBa:=255; + Pixel[1]:=Floor( (imgdata[(i*8)+4] AND $C0) / $40 + 1 ); + Pixel[2]:=Floor( (imgdata[(i*8)+4] AND $30) / $10 + 1 ); + Pixel[3]:=Floor( (imgdata[(i*8)+4] AND $0C) / $04 + 1 ); + Pixel[4]:=Floor( (imgdata[(i*8)+4] AND $03) + 1 ); + Pixel[5]:=Floor( (imgdata[(i*8)+5] AND $C0) / $40 + 1 ); + Pixel[6]:=Floor( (imgdata[(i*8)+5] AND $30) / $10 + 1 ); + Pixel[7]:=Floor( (imgdata[(i*8)+5] AND $0C) / $04 + 1 ); + Pixel[8]:=Floor( (imgdata[(i*8)+5] AND $03) + 1 ); + Pixel[9]:=Floor( (imgdata[(i*8)+6] AND $C0) / $40 + 1 ); + Pixel[10]:=Floor( (imgdata[(i*8)+6] AND $30) / $10 + 1 ); + Pixel[11]:=Floor( (imgdata[(i*8)+6] AND $0C) / $04 + 1 ); + Pixel[12]:=Floor( (imgdata[(i*8)+6] AND $03) + 1 ); + Pixel[13]:=Floor( (imgdata[(i*8)+7] AND $C0) / $40 + 1 ); + Pixel[14]:=Floor( (imgdata[(i*8)+7] AND $30) / $10 + 1 ); + Pixel[15]:=Floor( (imgdata[(i*8)+7] AND $0C) / $04 + 1 ); + Pixel[16]:=Floor( (imgdata[(i*8)+7] AND $03) + 1 ); + FOR j:=0 TO 3 DO BEGIN + Result[((y+3)*imgx+x+j)*3+0]:=Color[Pixel[16-j]].RGBb; + Result[((y+3)*imgx+x+j)*3+1]:=Color[Pixel[16-j]].RGBg; + Result[((y+3)*imgx+x+j)*3+2]:=Color[Pixel[16-j]].RGBr; + END; + FOR j:=0 TO 3 DO BEGIN + Result[((y+2)*imgx+x+j)*3+0]:=Color[Pixel[12-j]].RGBb; + Result[((y+2)*imgx+x+j)*3+1]:=Color[Pixel[12-j]].RGBg; + Result[((y+2)*imgx+x+j)*3+2]:=Color[Pixel[12-j]].RGBr; + END; + FOR j:=0 TO 3 DO BEGIN + Result[((y+1)*imgx+x+j)*3+0]:=Color[Pixel[8-j]].RGBb; + Result[((y+1)*imgx+x+j)*3+1]:=Color[Pixel[8-j]].RGBg; + Result[((y+1)*imgx+x+j)*3+2]:=Color[Pixel[8-j]].RGBr; + END; + FOR j:=0 TO 3 DO BEGIN + Result[((y+0)*imgx+x+j)*3+0]:=Color[Pixel[4-j]].RGBb; + Result[((y+0)*imgx+x+j)*3+1]:=Color[Pixel[4-j]].RGBg; + Result[((y+0)*imgx+x+j)*3+2]:=Color[Pixel[4-j]].RGBr; + END; + x:=x+4; + IF x=imgx THEN BEGIN + y:=y+4; + x:=0; + END; + END; + END; + + +FUNCTION ImgdataToBmp(imgx,imgy,imgdepth,storetype:LongWord; imgdata:Tdata):Tdata; + CONST BMPheader:Array[0..53] OF Byte= + ($42,$4D,0,0,0,0,0,0,0,0,54,0,0,0, + 40,0,0,0,0,0,0,0,0,0,0,0,1,0,$18,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0); + VAR + i,x,y:LongWord; + BEGIN + CASE storetype OF + 0: BEGIN + SetLength(Result,imgx*imgy*3); + FOR y:=0 TO imgy-1 DO BEGIN + FOR x:=0 TO imgx-1 DO BEGIN + Result[((imgx*y+x)*3)+0]:=Floor( ( (imgdata[(imgx*y+x)*2]+imgdata[(imgx*y+x)*2+1]*256) AND $000F ) / $000F * 255); + Result[((imgx*y+x)*3)+1]:=Floor( ( (imgdata[(imgx*y+x)*2]+imgdata[(imgx*y+x)*2+1]*256) AND $00F0 ) / $00F0 * 255); + Result[((imgx*y+x)*3)+2]:=Floor( ( (imgdata[(imgx*y+x)*2]+imgdata[(imgx*y+x)*2+1]*256) AND $0F00 ) / $0F00 * 255); + END; + END; + END; + 1,2: BEGIN + SetLength(Result,imgx*imgy*3); + FOR y:=0 TO imgy-1 DO BEGIN + FOR x:=0 TO imgx-1 DO BEGIN + Result[((imgx*y+x)*3)+0]:=Floor( ( (imgdata[(imgx*y+x)*2]+imgdata[(imgx*y+x)*2+1]*256) AND $001F ) / $001F * 255); + Result[((imgx*y+x)*3)+1]:=Floor( ( (imgdata[(imgx*y+x)*2]+imgdata[(imgx*y+x)*2+1]*256) AND $03E0 ) / $03E0 * 255); + Result[((imgx*y+x)*3)+2]:=Floor( ( (imgdata[(imgx*y+x)*2]+imgdata[(imgx*y+x)*2+1]*256) AND $7C00 ) / $7C00 * 255); + END; + END; + END; + 8: BEGIN + SetLength(Result,imgx*imgy*3); + FOR y:=0 TO imgy-1 DO BEGIN + FOR x:=0 TO imgx-1 DO BEGIN + Result[((imgx*y+x)*3)+0]:=imgdata[(imgx*y+x)*4+0]; + Result[((imgx*y+x)*3)+1]:=imgdata[(imgx*y+x)*4+1]; + Result[((imgx*y+x)*3)+2]:=imgdata[(imgx*y+x)*4+2]; + END; + END; + END; + 9: BEGIN + Result:=DecompressImage(imgx,imgy,imgdata); + END; + END; + Result:=RevertImage(imgx,imgy,24,Result); + SetLength(Result,imgx*imgy*3+54); + FOR i:=High(Result)-54 DOWNTO 0 DO Result[i+54]:=Result[i]; + + FOR i:=0 TO High(BMPheader) DO Result[i]:=BMPheader[i]; + Result[2]:=((imgx*imgy*3+54) AND $000000FF); + Result[3]:=((imgx*imgy*3+54) AND $0000FF00) DIV $100; + Result[4]:=((imgx*imgy*3+54) AND $00FF0000) DIV $10000; + Result[5]:=((imgx*imgy*3+54) AND $FF000000) DIV $1000000; + Result[18]:=(imgx AND $000000FF) DIV $1; + Result[19]:=(imgx AND $0000FF00) DIV $100; + Result[20]:=(imgx AND $00FF0000) DIV $10000; + Result[21]:=(imgx AND $FF000000) DIV $1000000; + Result[22]:=(imgy AND $000000FF) DIV $1; + Result[23]:=(imgy AND $0000FF00) DIV $100; + Result[24]:=(imgy AND $00FF0000) DIV $10000; + Result[25]:=(imgy AND $FF000000) DIV $1000000; + Result[34]:=((imgx*imgy*3) AND $000000FF) DIV $1; + Result[35]:=((imgx*imgy*3) AND $0000FF00) DIV $100; + Result[36]:=((imgx*imgy*3) AND $00FF0000) DIV $10000; + Result[37]:=((imgx*imgy*3) AND $FF000000) DIV $1000000; + END; + +FUNCTION BmpToImgdata(bmpdata:Tdata; _32bit:Boolean):TImgPackage; + VAR + x,y:LongWord; + r24,g24,b24:Word; + r16,g16,b16:Word; + gesamt:Word; + BEGIN + Result.imgdepth:=0; + IF NOT((bmpdata[00]=$42) AND (bmpdata[01]=$4D)) THEN BEGIN + ShowMessage('Not a standard 24bit bitmap'); + Exit; + END; + IF NOT(bmpdata[10]=54) THEN BEGIN + ShowMessage('Imagedata has to start at 0x54'); + Exit; + END; + IF NOT(bmpdata[14]=40) THEN BEGIN + ShowMessage('Second bitmap header has to have 40 bytes'); + Exit; + END; + IF NOT(bmpdata[28]=24) THEN BEGIN + ShowMessage('Bitmap has to have 24bits'); + Exit; + END; + IF NOT(bmpdata[30]=0) THEN BEGIN + ShowMessage('Bitmap has to be uncompressed'); + Exit; + END; + Result.imgx:=bmpdata[18]+bmpdata[19]*256+bmpdata[20]*256*256+bmpdata[21]*256*256*256; + Result.imgy:=bmpdata[22]+bmpdata[23]*256+bmpdata[24]*256*256+bmpdata[25]*256*256*256; + IF _32bit THEN BEGIN + Result.imgdepth:=32; + Result.storetype:=8; + END ELSE BEGIN + Result.imgdepth:=16; + Result.storetype:=1; + END; + + SetLength(Result.imgdata,Result.imgx*Result.imgy*Result.imgdepth DIV 8); + IF _32bit THEN BEGIN + FOR y:=0 TO Result.imgy-1 DO BEGIN + FOR x:=0 TO Result.imgx-1 DO BEGIN + Result.imgdata[((Result.imgx*y+x)*4)+0]:=bmpdata[54+(Result.imgx*y+x)*3+0]; + Result.imgdata[((Result.imgx*y+x)*4)+1]:=bmpdata[54+(Result.imgx*y+x)*3+1]; + Result.imgdata[((Result.imgx*y+x)*4)+2]:=bmpdata[54+(Result.imgx*y+x)*3+2]; + Result.imgdata[((Result.imgx*y+x)*4)+3]:=0; + END; + END; + END ELSE BEGIN + FOR y:=0 TO Result.imgy-1 DO BEGIN + FOR x:=0 TO Result.imgx-1 DO BEGIN + r24:=bmpdata[54+(Result.imgx*y+x)*3+0]; + g24:=bmpdata[54+(Result.imgx*y+x)*3+1]; + b24:=bmpdata[54+(Result.imgx*y+x)*3+2]; + r16:=(Ceil(r24*$001F/255)) AND $001F; + g16:=(Ceil(g24*$03E0/255)) AND $03E0; + b16:=(Ceil(b24*$7C00/255)) AND $7C00; + gesamt:=r16+g16+b16; + Result.imgdata[((Result.imgx*y+x)*2)+0]:=gesamt AND $00FF; + Result.imgdata[((Result.imgx*y+x)*2)+1]:=(gesamt AND $FF00) DIV 256; + END; + END; + END; + + Result.imgdata:=RevertImage(Result.imgx,Result.imgy,Result.imgdepth,Result.imgdata); + END; + +FUNCTION LoadTXMBconnected(fileid:LongWord):TImgPackage; + VAR + i,x,y,x2,y2,pixelid,imgid:LongWord; + rows,cols:Word; + linkcount:LongWord; + link:LongWord; + single_image:TImgPackage; + images_decoded:Array OF TImgPackage; + x_start,y_start:LongWord; + BEGIN + LoadDatFilePart(fileid,$10,SizeOf(Result.imgx),@Result.imgx); + LoadDatFilePart(fileid,$12,SizeOf(Result.imgy),@Result.imgy); + LoadDatFilePart(fileid,$18,SizeOf(cols),@cols); + LoadDatFilePart(fileid,$1A,SizeOf(rows),@rows); + LoadDatFilePart(fileid,$1C,SizeOf(linkcount),@linkcount); + SetLength(images_decoded,linkcount); + FOR i:=0 TO linkcount-1 DO BEGIN + LoadDatFilePart(fileid,$20+i*4,SizeOf(link),@link); + link:=link DIV 256; + single_image:=LoadImgData(link); + images_decoded[i]:=BmpToImgdata(ImgdataToBmp(single_image.imgx,single_image.imgy,single_image.imgdepth,single_image.storetype,single_image.imgdata),False); + END; + SetLength(Result.imgdata,Result.imgx*Result.imgy*2); + FOR y:=0 TO rows-1 DO BEGIN + FOR x:=0 TO cols-1 DO BEGIN + imgid:=y*cols+x; + x_start:=0; + y_start:=0; + FOR i:=0 TO x DO IF i=400 THEN BEGIN + END ELSE Self.Width:=400; + IF Self.Height>=350 THEN BEGIN + END ELSE Self.Height:=350; + END; + +PROCEDURE TForm7.list_txmpClick(Sender: TObject); + VAR + id:LongWord; + data:Tdata; + img:TImgPackage; + mem:TMemoryStream; + fadingbyte,depthbyte,storebyte:Byte; + BEGIN + id:=StrToInt(MidStr(list_txmp.Items.Strings[list_txmp.ItemIndex],1,5)); + + LoadDatFilePart(id,$88,SizeOf(fadingbyte),@fadingbyte); + LoadDatFilePart(id,$89,SizeOf(depthbyte),@depthbyte); + LoadDatFilePart(id,$90,SizeOf(storebyte),@storebyte); + check_fading.Checked:=(fadingbyte AND $01)>0; + check_transparency.Checked:=(depthbyte AND $04)>0; + check_32bit.Checked:=(storebyte=8); + + img:=LoadImgData(id); + data:=ImgdataToBmp(img.imgx,img.imgy,img.imgdepth,img.storetype,img.imgdata); + + mem:=TMemoryStream.Create; + mem.Write(data[0],Length(data)); + mem.Seek(0,soFromBeginning); + image_txmppreview.Picture.Bitmap.LoadFromStream(mem); + mem.Free; + + group_bmpselect.Enabled:=True; + END; + +PROCEDURE TForm7.btn_loadClick(Sender: TObject); + VAR + bmpfile:TFileStream; + mem:TMemoryStream; + BEGIN + IF opend.Execute THEN BEGIN + bmpfile:=TFileStream.Create(opend.FileName, fmOpenRead); + SetLength(actual_bmpdata,bmpfile.Size); + bmpfile.Read(actual_bmpdata[0],bmpfile.Size); + bmpfile.Free; + + mem:=TMemoryStream.Create; + mem.Write(actual_bmpdata[0],Length(actual_bmpdata)); + mem.Seek(0,soFromBeginning); + image_bmppreview.Picture.Bitmap.LoadFromStream(mem); + mem.Free; + + group_options.Enabled:=True; + END; + END; + +PROCEDURE TForm7.btn_replaceClick(Sender: TObject); + VAR + id:LongWord; + imgpkg:TImgPackage; + rawfile:TFileStream; + datfile:TFileStream; + dataddr:LongWord; + old_rawaddr,new_rawaddr:LongWord; + oldwidth,oldheight:Word; + oldstore,olddepth,oldfading:Byte; + oldsize:LongWord; + newsize:LongWord; + datbyte:Word; + BEGIN + IF list_txmp.ItemIndex>=0 THEN BEGIN + imgpkg:=BmpToImgdata(actual_bmpdata,check_32bit.Checked); + datfile:=TFileStream.Create(dat_filename,fmOpenReadWrite); + + id:=StrToInt(MidStr(list_txmp.Items.Strings[list_txmp.ItemIndex],1,5)); + dataddr:=dat_files[id].dataddr; + datfile.Seek(dataddr+$8C,soFromBeginning); + datfile.Read(oldwidth,2); + datfile.Seek(dataddr+$8E,soFromBeginning); + datfile.Read(oldheight,2); + datfile.Seek(dataddr+$88,soFromBeginning); + datfile.Read(oldfading,1); + datfile.Seek(dataddr+$89,soFromBeginning); + datfile.Read(olddepth,1); + datfile.Seek(dataddr+$90,soFromBeginning); + datfile.Read(oldstore,1); + datfile.Seek(dataddr+$9C,soFromBeginning); + datfile.Read(old_rawaddr,4); + IF (oldwidth<>imgpkg.imgx) OR (oldheight<>imgpkg.imgy) THEN BEGIN + IF MessageBox(Self.Handle, + PChar('Current image and new image have different size'+CrLf+ + '(Current: '+IntToStr(oldwidth)+'x'+IntToStr(oldheight)+ + ' - New: '+IntToStr(imgpkg.imgx)+'x'+IntToStr(imgpkg.imgy)+')'+CrLf+ + 'Replace anyways?'), + PChar(list_txmp.Items.Strings[list_txmp.ItemIndex]), + MB_YESNO)=IDNO THEN Exit; + END; + + rawfile:=TFileStream.Create(raw_filename,fmOpenReadWrite); + + CASE oldstore OF + 9: oldsize:=GetImageDataSize(oldwidth,oldheight,8,(oldfading AND $01)>0); + 0,1,2: oldsize:=GetImageDataSize(oldwidth,oldheight,16,(oldfading AND $01)>0); + 8: oldsize:=GetImageDataSize(oldwidth,oldheight,32,(oldfading AND $01)>0); + ELSE + oldsize:=0; + END; + IF check_32bit.Checked THEN + newsize:=GetImageDataSize(imgpkg.imgx,imgpkg.imgy,32,check_fading.Checked) + ELSE + newsize:=GetImageDataSize(imgpkg.imgx,imgpkg.imgy,16,check_fading.Checked); + + IF newsize<=oldsize THEN + new_rawaddr:=old_rawaddr + ELSE + new_rawaddr:=rawfile.Size; + + datbyte:=$00; + IF check_fading.Checked THEN datbyte:=datbyte OR $01; + datfile.Seek(dataddr+$88,soFromBeginning); + datfile.Write(datbyte,1); + datbyte:=$10; + IF check_transparency.Checked THEN datbyte:=datbyte OR $04; + datfile.Seek(dataddr+$89,soFromBeginning); + datfile.Write(datbyte,1); + datfile.Seek(dataddr+$8C,soFromBeginning); + datfile.Write(imgpkg.imgx,2); + datfile.Seek(dataddr+$8E,soFromBeginning); + datfile.Write(imgpkg.imgy,2); + IF check_32bit.Checked THEN + datbyte:=$08 + ELSE + datbyte:=$01; + datfile.Seek(dataddr+$90,soFromBeginning); + datfile.Write(datbyte,1); + datfile.Seek(dataddr+$9C,soFromBeginning); + datfile.Write(new_rawaddr,4); + datfile.Free; + + IF check_fading.Checked THEN BEGIN + imgpkg.imgdata:=CreateFadedImage(imgpkg); + END; + + rawfile.Seek(new_rawaddr,soFromBeginning); + rawfile.Write(imgpkg.imgdata[0],Length(imgpkg.imgdata)); + rawfile.Free; + + ShowMessage('TXMP-image replaced'); + END; + END; + +PROCEDURE TForm7.FormClose(Sender: TObject; var Action: TCloseAction); + VAR + i:Byte; + BEGIN + FOR i:=0 TO Form1.menu_windows.Count-1 DO BEGIN + IF Form1.menu_windows.Items[i].Name='menu_window_'+Self.Name THEN BEGIN + Form1.menu_windows.Items[i].Free; + Break; + END; + END; + Form1.menu_tools.Enabled:=True; + Action:=caFree; + END; + +END. Index: /oup/releases/0.18a/Unit8_binedit.dfm =================================================================== --- /oup/releases/0.18a/Unit8_binedit.dfm (revision 21) +++ /oup/releases/0.18a/Unit8_binedit.dfm (revision 21) @@ -0,0 +1,204 @@ +object Form8: TForm8 + Left = 0 + Top = 0 + Width = 650 + Height = 450 + Caption = 'Binary .dat-Editor' + Color = clBtnFace + Font.Charset = DEFAULT_CHARSET + Font.Color = clWindowText + Font.Height = -11 + Font.Name = 'Tahoma' + Font.Style = [] + FormStyle = fsMDIChild + OldCreateOrder = False + Visible = True + OnClose = FormClose + OnCloseQuery = FormCloseQuery + OnCreate = FormCreate + OnResize = FormResize + PixelsPerInch = 96 + TextHeight = 13 + object Splitter1: TSplitter + Left = 150 + Top = 0 + Width = 9 + Height = 423 + AutoSnap = False + Beveled = True + MinSize = 150 + end + object panel_data: TPanel + Left = 159 + Top = 0 + Width = 483 + Height = 423 + Align = alClient + BevelOuter = bvNone + TabOrder = 0 + OnResize = panel_dataResize + object Splitter2: TSplitter + Left = 0 + Top = 300 + Width = 483 + Height = 9 + Cursor = crVSplit + Align = alTop + AutoSnap = False + Beveled = True + MinSize = 100 + end + object hex: TMPHexEditor + Left = 0 + Top = 0 + Width = 483 + Height = 300 + Cursor = crIBeam + Align = alTop + Font.Charset = DEFAULT_CHARSET + Font.Color = clWindowText + Font.Height = -16 + Font.Name = 'Courier' + Font.Style = [] + ParentFont = False + TabOrder = 0 + BytesPerRow = 16 + Translation = tkASCII + OffsetFormat = '6!10:0x|' + Colors.Background = clWindow + Colors.ChangedBackground = clWindow + Colors.ChangedText = clRed + Colors.CursorFrame = clNavy + Colors.Offset = clBlack + Colors.OddColumn = clBlue + Colors.EvenColumn = clNavy + Colors.CurrentOffsetBackground = clBtnShadow + Colors.OffsetBackGround = clBtnFace + Colors.CurrentOffset = clBtnHighlight + Colors.Grid = clBtnFace + Colors.NonFocusCursorFrame = clAqua + Colors.ActiveFieldBackground = clWindow + FocusFrame = True + AllowInsertMode = False + DrawGridLines = False + Version = 'May 23, 2005; '#169' markus stephany, vcl[at]mirkes[dot]de' + OnChange = hexChange + ShowPositionIfNotFocused = True + OnSelectionChanged = hexSelectionChanged + end + object structs: TWrapGrid + Left = 0 + Top = 309 + Width = 483 + Height = 114 + Align = alClient + DefaultColWidth = 92 + DefaultRowHeight = 18 + FixedCols = 0 + Options = [goFixedVertLine, goFixedHorzLine, goVertLine, goHorzLine] + TabOrder = 1 + OnClick = structsClick + end + end + object panel_files: TPanel + Left = 0 + Top = 0 + Width = 150 + Height = 423 + Align = alLeft + BevelOuter = bvNone + TabOrder = 1 + object Bevel1: TBevel + Left = 0 + Top = 359 + Width = 150 + Height = 6 + Align = alBottom + Style = bsRaised + end + object list: TListBox + Left = 0 + Top = 0 + Width = 150 + Height = 315 + Align = alClient + ItemHeight = 13 + TabOrder = 0 + OnClick = listClick + end + object panel_extension: TPanel + Left = 0 + Top = 315 + Width = 150 + Height = 44 + Align = alBottom + BevelOuter = bvNone + TabOrder = 1 + OnResize = panel_extensionResize + object Label1: TLabel + Left = 2 + Top = 4 + Width = 100 + Height = 17 + AutoSize = False + Caption = 'Filter by extension:' + end + object combo_extension: TComboBox + Left = 2 + Top = 20 + Width = 145 + Height = 21 + Style = csDropDownList + DropDownCount = 12 + Font.Charset = DEFAULT_CHARSET + Font.Color = clWindowText + Font.Height = -11 + Font.Name = 'Tahoma' + Font.Style = [] + ItemHeight = 13 + ParentFont = False + Sorted = True + TabOrder = 0 + OnClick = combo_extensionClick + end + end + object panel_imexport: TPanel + Left = 0 + Top = 365 + Width = 150 + Height = 58 + Align = alBottom + BevelOuter = bvNone + TabOrder = 2 + OnResize = panel_imexportResize + object btn_export: TButton + Left = 4 + Top = 4 + Width = 142 + Height = 25 + Caption = '&Export to file...' + TabOrder = 0 + OnClick = btn_exportClick + end + object btn_import: TButton + Left = 4 + Top = 32 + Width = 142 + Height = 25 + Caption = '&Import from file...' + TabOrder = 1 + OnClick = btn_importClick + end + end + end + object opend: TOpenDialog + Options = [ofPathMustExist, ofFileMustExist, ofEnableSizing] + Left = 120 + Top = 392 + end + object saved: TSaveDialog + Options = [ofOverwritePrompt, ofPathMustExist, ofEnableSizing] + Left = 120 + Top = 368 + end +end Index: /oup/releases/0.18a/Unit8_binedit.pas =================================================================== --- /oup/releases/0.18a/Unit8_binedit.pas (revision 21) +++ /oup/releases/0.18a/Unit8_binedit.pas (revision 21) @@ -0,0 +1,354 @@ +UNIT Unit8_binedit; +INTERFACE +USES + Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, + Dialogs, Wrapgrid, StdCtrls, Grids, StrUtils, MPHexEditor, ExtCtrls, + Unit3_data, Unit2_functions, Unit9_data_structures, Unit4_exporters; + +TYPE + TForm8 = Class(TForm) + Splitter1: TSplitter; + panel_data: TPanel; + hex: TMPHexEditor; + Splitter2: TSplitter; + structs: TWrapGrid; + panel_files: TPanel; + list: TListBox; + panel_extension: TPanel; + Label1: TLabel; + combo_extension: TComboBox; + Bevel1: TBevel; + panel_imexport: TPanel; + btn_export: TButton; + btn_import: TButton; + opend: TOpenDialog; + saved: TSaveDialog; + PROCEDURE btn_importClick(Sender: TObject); + PROCEDURE btn_exportClick(Sender: TObject); + PROCEDURE panel_imexportResize(Sender: TObject); + FUNCTION Save:Boolean; + PROCEDURE FormClose(Sender: TObject; var Action: TCloseAction); + PROCEDURE combo_extensionClick(Sender: TObject); + PROCEDURE panel_extensionResize(Sender: TObject); + FUNCTION GetValue(datatype:Byte; offset:LongWord):String; + PROCEDURE WriteStructureInfos(structinfoid:Integer); + PROCEDURE hexSelectionChanged(Sender: TObject); + PROCEDURE hexChange(Sender: TObject); + PROCEDURE panel_dataResize(Sender: TObject); + PROCEDURE structsClick(Sender: TObject); + PROCEDURE FormResize(Sender: TObject); + PROCEDURE ClearStructViewer; + PROCEDURE listClick(Sender: TObject); + PROCEDURE FormCloseQuery(Sender: TObject; var CanClose: Boolean); + PROCEDURE FormCreate(Sender: TObject); + PROCEDURE Recreatelist; + PRIVATE + PUBLIC + END; + +VAR + Form8: TForm8; + +IMPLEMENTATION +{$R *.dfm} +USES Unit1_main; +VAR + fileid:LongWord; + +FUNCTION IntToBin(value:Byte):String; + VAR i:Byte; + BEGIN + Result:=''; + FOR i:=7 DOWNTO 0 DO BEGIN + Result:=Result+IntToStr((value SHR i) AND $01); + END; + END; + +FUNCTION TForm8.GetValue(datatype:Byte; offset:LongWord):String; + VAR + data:Tdata; + BEGIN + CASE datatype OF + 1: Result:=IntToStr(Self.hex.data[offset]); + 2: Result:=IntToStr(Self.hex.data[offset]+Self.hex.data[offset+1]*256); + 3: Result:=IntToStr(Self.hex.data[offset]+Self.hex.data[offset+1]*256+Self.hex.data[offset+2]*256*256); + 4: Result:=IntToStr(Self.hex.data[offset]+Self.hex.data[offset+1]*256+Self.hex.data[offset+2]*256*256+Self.hex.data[offset+3]*256*256*256); + 5: Result:='0x'+IntToHex(Self.hex.data[offset],2); + 6: Result:='0x'+IntToHex(Self.hex.data[offset]+Self.hex.data[offset+1]*256,4); + 7: Result:='0x'+IntToHex(Self.hex.data[offset]+Self.hex.data[offset+1]*256+Self.hex.data[offset+2]*256*256,6); + 8: Result:='0x'+IntToHex(Self.hex.data[offset]+Self.hex.data[offset+1]*256+Self.hex.data[offset+2]*256*256+Self.hex.data[offset+3]*256*256*256,8); + 9: BEGIN + SetLength(data,4); + data[0]:=Self.hex.data[offset]; + data[1]:=Self.hex.data[offset+1]; + data[2]:=Self.hex.data[offset+2]; + data[3]:=Self.hex.data[offset+3]; + Result:=FloatToStr(Decode_Float(data)); + END; + 10: Result:=IntToBin(Self.hex.data[offset]); + END; + END; + +PROCEDURE TForm8.WriteStructureInfos(structinfoid:Integer); + VAR + i:Byte; + BEGIN + IF structinfoid>=0 THEN BEGIN + WITH structure_infos[structinfoid] DO BEGIN + Self.structs.RowCount:=Length(entries)+1; + FOR i:=1 TO Length(entries) DO BEGIN + Self.structs.Cells[0,i]:=entries[i-1].name; + Self.structs.Cells[1,i]:='0x'+IntToHex(entries[i-1].offset,6); + Self.structs.Cells[2,i]:=GetDataType(entries[i-1].datatype); + Self.structs.Cells[3,i]:=Self.GetValue(entries[i-1].datatype,entries[i-1].offset); + Self.structs.Cells[4,i]:=entries[i-1].description; + END; + END; + END; + END; + +PROCEDURE TForm8.Recreatelist; + VAR + i:LongWord; + BEGIN + combo_extension.Items.Clear; + combo_extension.Items.Add('_All files_ ('+IntToStr(dat_header.Files)+')'); + FOR i:=0 TO dat_header.Extensions-1 DO BEGIN + WITH dat_extensionsmap[i] DO BEGIN + combo_extension.Items.Add( + Extension[3]+Extension[2]+Extension[1]+Extension[0]+' ('+ + IntToStr(ExtCount)+')'); + END; + END; + combo_extension.ItemIndex:=0; + combo_extensionClick(Self); + END; + +PROCEDURE TForm8.FormCreate(Sender: TObject); + BEGIN + Self.Caption:=''; + fileid:=0; + structs.ColCount:=5; + structs.RowCount:=2; + structs.FixedRows:=1; + structs.Cells[0,0]:='Name'; + structs.Cells[1,0]:='Offset'; + structs.Cells[2,0]:='Type'; + structs.Cells[3,0]:='Value'; + structs.Cells[4,0]:='Description'; + structs.ColWidths[0]:=75; + structs.ColWidths[1]:=60; + structs.ColWidths[2]:=75; + structs.ColWidths[3]:=75; + Self.panel_dataResize(Self); + END; + +FUNCTION TForm8.Save:Boolean; + VAR + mem:TMemoryStream; + data:Tdata; + BEGIN + CASE MessageBox(Self.Handle,PChar('Save changes to file '+dat_files[fileid].FileName+'?'),PChar('Data changed...'),MB_YESNOCANCEL) OF + IDYES: BEGIN + mem:=TMemoryStream.Create; + hex.SaveToStream(mem); + mem.Seek(0,soFromBeginning); + SetLength(data,mem.Size); + mem.Read(data[0],mem.Size); + mem.Free; + SaveDatFile(fileid,data); + Result:=True; + END; + IDNO: Result:=True; + IDCANCEL: BEGIN + Result:=False; + END; + END; + END; + +PROCEDURE TForm8.FormCloseQuery(Sender: TObject; var CanClose: Boolean); + BEGIN + IF hex.Modified THEN BEGIN + IF NOT Save THEN CanClose:=False; + END; + END; + +PROCEDURE TForm8.listClick(Sender: TObject); + VAR + mem:TMemoryStream; + data:Tdata; + i:LongWord; + BEGIN + IF hex.Modified THEN BEGIN + IF NOT Save THEN BEGIN + FOR i:=0 TO list.Count-1 DO BEGIN + IF StrToInt(MidStr(list.Items.Strings[i],1,5))=fileid THEN BEGIN + list.ItemIndex:=i; + Exit; + END; + END; + END; + END; + Self.ClearStructViewer; + fileid:=StrToInt(MidStr(list.Items.Strings[list.ItemIndex],1,5)); + data:=LoadDatFile(fileid); + mem:=TMemoryStream.Create; + mem.Write(data[0],Length(data)); + hex.LoadFromStream(mem); + mem.Free; + WriteStructureInfos(GetStructureInfoId(dat_files[fileid].Extension)); + END; + +PROCEDURE TForm8.ClearStructViewer; + VAR + x:Word; + BEGIN + structs.RowCount:=2; + FOR x:=0 TO structs.ColCount-1 DO structs.Cells[x,1]:=''; + END; + +PROCEDURE TForm8.FormResize(Sender: TObject); + BEGIN + IF Self.Width>=650 THEN BEGIN + END ELSE Self.Width:=650; + IF Self.Height>=450 THEN BEGIN + END ELSE Self.Height:=450; + END; + +PROCEDURE TForm8.structsClick(Sender: TObject); + VAR + offset:LongWord; + length:Byte; + BEGIN + IF structs.Row>0 THEN BEGIN + offset:=structure_infos[GetStructureInfoId(dat_files[fileid].extension)].entries[structs.Row-1].offset; + length:=GetTypeDataLength(structure_infos[GetStructureInfoId(dat_files[fileid].extension)].entries[structs.Row-1].datatype); + hex.SelStart:=offset; + hex.SelEnd:=offset+length-1; + END; + END; + +PROCEDURE TForm8.panel_dataResize(Sender: TObject); + BEGIN + structs.ColWidths[4]:=structs.Width-structs.ColWidths[0]-structs.ColWidths[1]-structs.ColWidths[2]-structs.ColWidths[3]-28; + END; + +PROCEDURE TForm8.hexChange(Sender: TObject); + BEGIN + IF hex.DataSize>0 THEN + WriteStructureInfos(GetStructureInfoId(dat_files[fileid].Extension)); + END; + +PROCEDURE TForm8.hexSelectionChanged(Sender: TObject); + VAR + selstart:Integer; + i,j:Word; + BEGIN + FOR i:=1 TO structs.RowCount-1 DO BEGIN + FOR j:=0 TO structs.ColCount-1 DO BEGIN + structs.CellColors[j,i]:=clWhite; + structs.CellFontColors[j,i]:=clBlack; + END; + END; + IF hex.DataSize>0 THEN BEGIN + selstart:=hex.SelStart; + IF GetStructureInfoId(dat_files[fileid].Extension)>=0 THEN BEGIN + WITH structure_infos[GetStructureInfoId(dat_files[fileid].Extension)] DO BEGIN + FOR i:=0 TO High(entries) DO BEGIN + IF ((selstart-entries[i].offset)=0) THEN BEGIN + FOR j:=0 TO structs.ColCount-1 DO BEGIN + structs.CellColors[j,i+1]:=clBlue; + structs.CellFontColors[j,i+1]:=clWhite; + END; + structs.Row:=i+1; + END; + END; + END; + END; + END; + END; + +PROCEDURE TForm8.panel_extensionResize(Sender: TObject); + BEGIN + combo_extension.Width:=panel_extension.Width-5; + END; + +PROCEDURE TForm8.combo_extensionClick(Sender: TObject); + VAR + Extension:String[4]; + i:LongWord; + BEGIN + Extension:=MidStr(combo_extension.Items.Strings[combo_extension.ItemIndex],1,4); + list.Items.Clear; + IF Extension='_All' THEN BEGIN + FOR i:=0 TO dat_header.Files-1 DO + IF (dat_files[i].FileType AND $02)=0 THEN + list.Items.Add(dat_files[i].FileName); + END ELSE BEGIN + FOR i:=0 TO dat_header.Files-1 DO + IF dat_files[i].Extension=Extension THEN + IF (dat_files[i].FileType AND $02)=0 THEN + list.Items.Add(dat_files[i].FileName); + END; + IF list.Count>0 THEN BEGIN + list.ItemIndex:=0; + listClick(Self); + END; + END; + +PROCEDURE TForm8.FormClose(Sender: TObject; var Action: TCloseAction); + VAR + i:Byte; + BEGIN + FOR i:=0 TO Form1.menu_windows.Count-1 DO BEGIN + IF Form1.menu_windows.Items[i].Name='menu_window_'+Self.Name THEN BEGIN + Form1.menu_windows.Items[i].Free; + Break; + END; + END; + Form1.menu_tools.Enabled:=True; + Action:=caFree; + END; + +PROCEDURE TForm8.panel_imexportResize(Sender: TObject); + BEGIN + btn_import.Width:=panel_imexport.Width-8; + btn_export.Width:=panel_imexport.Width-8; + END; + +PROCEDURE TForm8.btn_exportClick(Sender: TObject); + BEGIN + saved.Filter:='Files of matching extension (*.'+dat_files[fileid].Extension+')|*.'+dat_files[fileid].Extension+'|All files|*.*'; + saved.DefaultExt:=dat_files[fileid].Extension; + IF saved.Execute THEN BEGIN + ExportDatFile(fileid,saved.FileName); + END; + END; + +PROCEDURE TForm8.btn_importClick(Sender: TObject); + VAR + data:Tdata; + fs:TFileStream; + BEGIN + opend.Filter:='Files of matching extension (*.'+dat_files[fileid].Extension+')|*.'+dat_files[fileid].Extension+'|All files|*.*'; + IF opend.Execute THEN BEGIN + fs:=TFileStream.Create(opend.FileName,fmOpenRead); + IF fs.Size<>dat_files[fileid].size THEN BEGIN + ShowMessage('Can''t import '+ExtractFilename(opend.FileName)+ + ', file has to have same size as file in .dat.'+CrLf+ + 'Size of file in .dat: '+FormatFileSize(dat_files[fileid].size)+CrLf+ + 'Size of chosen file: '+FormatFileSize(fs.Size)); + END ELSE BEGIN + SetLength(data,fs.Size); + fs.Read(data[0],fs.Size); + fs.Free; + fs:=TFileStream.Create(dat_filename,fmOpenReadWrite); + fs.Seek(dat_files[fileid].dataddr,soFromBeginning); + fs.Write(data[0],Length(data)); + END; + fs.Free; + listClick(Self); + END; + END; + +END. Index: /oup/releases/0.18a/Unit9_data_structures.pas =================================================================== --- /oup/releases/0.18a/Unit9_data_structures.pas (revision 21) +++ /oup/releases/0.18a/Unit9_data_structures.pas (revision 21) @@ -0,0 +1,113 @@ +UNIT Unit9_data_structures; +INTERFACE +USES SysUtils; + +TYPE + Tstructure_entry=RECORD + name:String; + offset:LongWord; + datatype:Byte; // 1..4: Integer[1..4] dec; 5..8: Integer[1..4] hex; 9: float; 10: bitset; 11+: string[1+] + description:String; + END; + Tstructure_info=RECORD + extension:String; + typedesc:String; + entries:Array OF Tstructure_entry; + END; + Tstructures=Array OF Tstructure_info; + +VAR + structure_infos:Tstructures; + + +FUNCTION GetDataType(typeid:Byte):String; +FUNCTION GetStructureInfoId(ext:String):Integer; +FUNCTION GetTypeDataLength(datatype:Byte):Byte; + + + +IMPLEMENTATION + +FUNCTION GetTypeDataLength(datatype:Byte):Byte; + BEGIN + CASE datatype OF + 1..4: Result:=datatype; + 5..8: Result:=datatype-4; + 9: Result:=4; + 10: Result:=1; + 11..255: Result:=datatype-10; + END; + END; + + +FUNCTION GetStructureInfoId(ext:String):Integer; + VAR + i:Integer; + BEGIN + FOR i:=0 TO High(structure_infos) DO BEGIN + IF structure_infos[i].extension=ext THEN BEGIN + Result:=i; + Exit; + END; + END; + Result:=-1; + END; + + +FUNCTION GetDataType(typeid:Byte):String; + BEGIN + CASE typeid OF + 1..4: Result:='Int'+IntToStr(typeid*8); + 5..8: Result:='Int'+IntToStr((typeid-4)*8); + 9: Result:='Float'; + 10: Result:='BitSet'; + 11..255: Result:='String('+IntToStr(typeid-10)+')'; + END; + END; + + +PROCEDURE AddEntry(_ext:String; _name:String; _offset:LongWord; _datatype:Byte; _description:String); + VAR + sid:Integer; + BEGIN + sid:=GetStructureInfoId(_ext); + IF sid>=0 THEN BEGIN + WITH structure_infos[sid] DO BEGIN + SetLength(entries,Length(entries)+1); + WITH entries[High(entries)] DO BEGIN + name:=_name; + offset:=_offset; + datatype:=_datatype; + description:=_description; + END; + END; + END; + END; + + +PROCEDURE AddExtension(_ext:String; _typedesc:String); + BEGIN + IF GetStructureInfoId(_ext)<0 THEN BEGIN + SetLength(structure_infos,Length(structure_infos)+1); + WITH structure_infos[High(structure_infos)] DO BEGIN + extension:='TXMP'; + typedesc:='Texture'; + END; + END; + END; + + +BEGIN + AddExtension('TXMP','Texture'); + AddEntry('TXMP','ID',$00,8,'ID of this file'); + AddEntry('TXMP','LevelID',$04,8,'ID of the level this file is in'); + AddEntry('TXMP','FileName',$08,138,''); + AddEntry('TXMP','Fading',$88,10,'Fading-Bitset'); + AddEntry('TXMP','Depth',$89,10,'Depth-Bitset'); + AddEntry('TXMP','Width',$8C,2,'x-resolution of image'); + AddEntry('TXMP','Height',$8E,2,'y-resolution of image'); + AddEntry('TXMP','Storetype',$90,10,'Storetype-Bitset'); + AddEntry('TXMP','TXAN-Link',$94,8,'Link to the TXAN-file (if this TXMP is the first image of an animation)'); + AddEntry('TXMP','TXMP-Link',$98,8,'Link to another TXMP-file'); + AddEntry('TXMP','Raw-Link',$9C,8,'Address of the image data in the .raw-file'); +END. Index: /oup/releases/0.18a2/OniUnPacker.bdsproj =================================================================== --- /oup/releases/0.18a2/OniUnPacker.bdsproj (revision 21) +++ /oup/releases/0.18a2/OniUnPacker.bdsproj (revision 21) @@ -0,0 +1,171 @@ + + + + + + + + + + + + OniUnPacker.dpr + + + 7.0 + + + 8 + 0 + 1 + 1 + 0 + 0 + 1 + 1 + 1 + 0 + 0 + 1 + 0 + 1 + 1 + 1 + 0 + 0 + 0 + 0 + 0 + 1 + 0 + 1 + 1 + 1 + True + True + WinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE; + + False + + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + False + False + False + True + True + True + + + 0 + 0 + 1 + False + False + False + 16384 + 1048576 + 4194304 + + + + + + + + + xmlrtl;rtl;vcl;vclie;inet;inetdbbde;inetdbxpress;vclx;IndySystem;IndyCore;dbrtl;dsnap;soaprtl;IndyProtocols;bdertl;vcldbx;vcldb;webdsnap;websnap;vclactnband;GridPackd2005;TWrapGrid;Package1;A406_R70;CoolTrayIcon_D6plus + + + False + + + + + + False + + + + + + False + + + False + False + 1 + 0 + 0 + 0 + False + False + False + False + False + 1031 + 1252 + + + + + 1.0.0.0 + + + + + + 1.0.0.0 + + + (untitled) + Borland Web Wizard Package + + + Index: /oup/releases/0.18a2/OniUnPacker.cfg =================================================================== --- /oup/releases/0.18a2/OniUnPacker.cfg (revision 21) +++ /oup/releases/0.18a2/OniUnPacker.cfg (revision 21) @@ -0,0 +1,38 @@ +-$A8 +-$B- +-$C+ +-$D+ +-$E- +-$F- +-$G+ +-$H+ +-$I+ +-$J- +-$K- +-$L+ +-$M- +-$N+ +-$O+ +-$P+ +-$Q- +-$R- +-$S- +-$T- +-$U- +-$V+ +-$W- +-$X+ +-$YD +-$Z1 +-cg +-AWinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE; +-H+ +-W+ +-M +-$M16384,1048576 +-K$00400000 +-LE"C:\Dokumente und Einstellungen\Administrator\Eigene Dateien\Borland Studio Projects\Bpl" +-LN"C:\Dokumente und Einstellungen\Administrator\Eigene Dateien\Borland Studio Projects\Bpl" +-w-UNSAFE_TYPE +-w-UNSAFE_CODE +-w-UNSAFE_CAST Index: /oup/releases/0.18a2/OniUnPacker.dpr =================================================================== --- /oup/releases/0.18a2/OniUnPacker.dpr (revision 21) +++ /oup/releases/0.18a2/OniUnPacker.dpr (revision 21) @@ -0,0 +1,21 @@ +PROGRAM OniUnPacker; +uses + Forms, + Unit1_main in 'Unit1_main.pas' {Form1}, + Unit2_functions in 'Unit2_functions.pas', + Unit3_data in 'Unit3_data.pas', + Unit4_Exporters in 'Unit4_Exporters.pas', + Unit5_preview in 'Unit5_preview.pas' {Form5}, + Unit6_imgfuncs in 'Unit6_imgfuncs.pas', + Unit7_txmpreplace in 'Unit7_txmpreplace.pas' {Form7}, + Unit8_binedit in 'Unit8_binedit.pas' {Form8}, + Unit9_data_structures in 'Unit9_data_structures.pas'; + +{$R *.res} + +BEGIN + Application.Initialize; + Application.Title:='Oni Un/Packer'; + Application.CreateForm(TForm1, Form1); + Application.Run; +END. Index: /oup/releases/0.18a2/SQLite3.pas =================================================================== --- /oup/releases/0.18a2/SQLite3.pas (revision 21) +++ /oup/releases/0.18a2/SQLite3.pas (revision 21) @@ -0,0 +1,120 @@ +unit SQLite3; + +{ + Simplified interface for SQLite. + Updated for Sqlite 3 by Tim Anderson (tim@itwriting.com) + Note: NOT COMPLETE for version 3, just minimal functionality + Adapted from file created by Pablo Pissanetzky (pablo@myhtpc.net) + which was based on SQLite.pas by Ben Hochstrasser (bhoc@surfeu.ch) +} + +interface + +const +// Return values for sqlite3_exec() and sqlite3_step() + +SQLITE_OK = 0; // Successful result +SQLITE_ERROR = 1; // SQL error or missing database +SQLITE_INTERNAL = 2; // An internal logic error in SQLite +SQLITE_PERM = 3 ; // Access permission denied +SQLITE_ABORT = 4; // Callback routine requested an abort +SQLITE_BUSY = 5; // The database file is locked +SQLITE_LOCKED = 6; // A table in the database is locked +SQLITE_NOMEM = 7; // A malloc() failed +SQLITE_READONLY = 8; // Attempt to write a readonly database +SQLITE_INTERRUPT = 9; // Operation terminated by sqlite3_interrupt() +SQLITE_IOERR = 10; // Some kind of disk I/O error occurred +SQLITE_CORRUPT = 11; // The database disk image is malformed +SQLITE_NOTFOUND = 12; // (Internal Only) Table or record not found +SQLITE_FULL = 13; // Insertion failed because database is full +SQLITE_CANTOPEN = 14; // Unable to open the database file +SQLITE_PROTOCOL = 15; // Database lock protocol error +SQLITE_EMPTY = 16; // Database is empty +SQLITE_SCHEMA = 17; // The database schema changed +SQLITE_TOOBIG = 18; // Too much data for one row of a table +SQLITE_CONSTRAINT = 19; // Abort due to contraint violation +SQLITE_MISMATCH = 20; // Data type mismatch +SQLITE_MISUSE = 21; // Library used incorrectly +SQLITE_NOLFS = 22; // Uses OS features not supported on host +SQLITE_AUTH = 23; // Authorization denied +SQLITE_FORMAT = 24; // Auxiliary database format error +SQLITE_RANGE = 25; // 2nd parameter to sqlite3_bind out of range +SQLITE_NOTADB = 26; // File opened that is not a database file +SQLITE_ROW = 100; // sqlite3_step() has another row ready +SQLITE_DONE = 101; // sqlite3_step() has finished executing + +SQLITE_INTEGER = 1; +SQLITE_FLOAT = 2; +SQLITE_TEXT = 3; +SQLITE_BLOB = 4; +SQLITE_NULL = 5; + +type +TSQLiteDB = Pointer; +TSQLiteResult = ^PChar; +TSQLiteStmt = Pointer; + +function SQLite3_Open (dbname: PChar; var db: TSqliteDB): integer; cdecl; external 'sqlite3.dll' name 'sqlite3_open'; +function SQLite3_Close (db: TSQLiteDB): integer; cdecl; external 'sqlite3.dll' name 'sqlite3_close'; +function SQLite3_Exec (db: TSQLiteDB; SQLStatement: PChar; CallbackPtr: Pointer; Sender: TObject; var ErrMsg: PChar): integer; cdecl; external 'sqlite3.dll' name 'sqlite3_exec'; +function SQLite3_Version (): PChar; cdecl; external 'sqlite3.dll' name 'sqlite3_libversion'; +function SQLite3_ErrMsg (db: TSQLiteDB): PChar; cdecl; external 'sqlite3.dll' name 'sqlite3_errmsg'; +function SQLite3_ErrCode (db: TSQLiteDB): integer; cdecl; external 'sqlite3.dll' name 'sqlite3_errcode'; +procedure SQlite3_Free (P: PChar); cdecl; external 'sqlite3.dll' name 'sqlite3_free'; +function SQLite3_GetTable (db: TSQLiteDB; SQLStatement: PChar; var ResultPtr: TSQLiteResult; var RowCount: Cardinal; var ColCount: Cardinal; var ErrMsg: PChar): integer; cdecl; external 'sqlite3.dll' name 'sqlite3_get_table'; +procedure SQLite3_FreeTable (Table:TSQLiteResult ); cdecl; external 'sqlite3.dll' name 'sqlite3_free_table'; +function SQLite3_Complete (P: PChar): boolean; cdecl; external 'sqlite3.dll' name 'sqlite3_complete'; +function SQLite3_LastInsertRowID(db: TSQLiteDB): int64; cdecl; external 'sqlite3.dll' name 'sqlite3_last_insert_rowid'; +procedure SQLite3_Interrupt (db: TSQLiteDB); cdecl; external 'sqlite3.dll' name 'sqlite3_interrupt'; +procedure SQLite3_BusyHandler (db: TSQLiteDB; CallbackPtr: Pointer; Sender: TObject); cdecl; external 'sqlite3.dll' name'sqlite3_busy_handler' ; +procedure SQLite3_BusyTimeout (db: TSQLiteDB; TimeOut: integer); cdecl; external 'sqlite3.dll' name 'sqlite3_busy_timeout'; +function SQLite3_Changes (db: TSQLiteDB): integer; cdecl; external 'sqlite3.dll' name 'sqlite3_changes'; +function SQLite3_TotalChanges (db: TSQLiteDB): integer; cdecl; external 'sqlite3.dll' name 'sqlite3_total_changes'; +function SQLite3_Prepare (db: TSQLiteDB; SQLStatement: PChar; nBytes: integer; var hStmt: TSqliteStmt; var pzTail: PChar): integer; cdecl; external 'sqlite3.dll' name 'sqlite3_prepare'; +function SQLite3_ColumnCount (hStmt: TSqliteStmt): integer; cdecl; external 'sqlite3.dll' name 'sqlite3_column_count'; +function Sqlite3_ColumnName (hStmt: TSqliteStmt; ColNum: integer): pchar; cdecl; external 'sqlite3.dll' name 'sqlite3_column_name'; +function Sqlite3_ColumnDeclType (hStmt: TSqliteStmt; ColNum: integer): pchar; cdecl; external 'sqlite3.dll' name 'sqlite3_column_decltype'; +function Sqlite3_Step (hStmt: TSqliteStmt): integer; cdecl; external 'sqlite3.dll' name 'sqlite3_step'; +function SQLite3_DataCount (hStmt: TSqliteStmt): integer; cdecl; external 'sqlite3.dll' name 'sqlite3_data_count'; + +function Sqlite3_ColumnBlob (hStmt: TSqliteStmt; ColNum: integer):pointer; cdecl; external 'sqlite3.dll' name 'sqlite3_column_blob'; +function Sqlite3_ColumnBytes (hStmt: TSqliteStmt; ColNum: integer): integer; cdecl; external 'sqlite3.dll' name 'sqlite3_column_bytes'; +function Sqlite3_ColumnDouble (hStmt: TSqliteStmt; ColNum: integer): double; cdecl; external 'sqlite3.dll' name 'sqlite3_column_double'; +function Sqlite3_ColumnInt (hStmt: TSqliteStmt; ColNum: integer): integer; cdecl; external 'sqlite3.dll' name 'sqlite3_column_int'; +function Sqlite3_ColumnText (hStmt: TSqliteStmt; ColNum: integer): pchar; cdecl; external 'sqlite3.dll' name 'sqlite3_column_text'; +function Sqlite3_ColumnType (hStmt: TSqliteStmt; ColNum: integer): integer; cdecl; external 'sqlite3.dll' name 'sqlite3_column_type'; + // function Sqlite3_ColumnInt64 (hStmt: TSqliteStmt; ColNum: integer): SqliteInt64; cdecl; external 'sqlite3.dll' name 'sqlite3_column_int64'; +function SQLite3_Finalize (hStmt: TSqliteStmt): integer; cdecl; external 'sqlite3.dll' name 'sqlite3_finalize'; +function SQLite3_Reset (hStmt: TSqliteStmt): integer; cdecl; external 'sqlite3.dll' name 'sqlite3_reset'; + +// +// In the SQL strings input to sqlite3_prepare() and sqlite3_prepare16(), +// one or more literals can be replace by a wildcard "?" or ":N:" where +// N is an integer. These value of these wildcard literals can be set +// using the routines listed below. +// +// In every case, the first parameter is a pointer to the sqlite3_stmt +// structure returned from sqlite3_prepare(). The second parameter is the +// index of the wildcard. The first "?" has an index of 1. ":N:" wildcards +// use the index N. +// + // The fifth parameter to sqlite3_bind_blob(), sqlite3_bind_text(), and + //sqlite3_bind_text16() is a destructor used to dispose of the BLOB or +//text after SQLite has finished with it. If the fifth argument is the +// special value SQLITE_STATIC, then the library assumes that the information +// is in static, unmanaged space and does not need to be freed. If the +// fifth argument has the value SQLITE_TRANSIENT, then SQLite makes its +// own private copy of the data. +// +// The sqlite3_bind_* routine must be called before sqlite3_step() after +// an sqlite3_prepare() or sqlite3_reset(). Unbound wildcards are interpreted +// as NULL. +// + +function SQLite3_BindBlob(hStmt: TSqliteStmt; ParamNum: integer; +ptrData: pointer; numBytes: integer; ptrDestructor: pointer): integer; +cdecl; external 'sqlite3.dll' name 'sqlite3_bind_blob'; + +implementation + +end. Index: /oup/releases/0.18a2/SQLiteTable3.pas =================================================================== --- /oup/releases/0.18a2/SQLiteTable3.pas (revision 21) +++ /oup/releases/0.18a2/SQLiteTable3.pas (revision 21) @@ -0,0 +1,883 @@ +unit SQLiteTable3; + +{ + Simple classes for using SQLite's exec and get_table. + + TSQLiteDatabase wraps the calls to open and close an SQLite database. + It also wraps SQLite_exec for queries that do not return a result set + + TSQLiteTable wraps sqlite_get_table. + It allows accessing fields by name as well as index and can step through a + result set with the Next procedure. + + Adapted by Tim Anderson (tim@itwriting.com) + Originally created by Pablo Pissanetzky (pablo@myhtpc.net) +} + +interface + +uses + Windows, SQLite3, Classes, Sysutils; + +const + dtStr = 0; + dtInt = 1; + dtBool = 2; + dtNumeric = 3; + dtBlob = 4; + +type + + ESQLiteException = class(Exception) + private + public + end; + + TSQLiteTable = class; + + TSQLiteDatabase = class + private + fDB: TSQLiteDB; + fInTrans: Boolean; + procedure RaiseError(s: string; SQL: string); + + public + constructor Create(const FileName: string); + destructor Destroy; override; + function GetTable(const SQL: string): TSQLiteTable; + procedure ExecSQL(const SQL: string); + procedure UpdateBlob(const SQL: string; BlobData: TStream); + procedure BeginTransaction; + procedure Commit; + procedure Rollback; + function TableExists(TableName: string): boolean; + function GetLastInsertRowID: int64; + + published + property isTransactionOpen: boolean read fInTrans; + + end; + + TSQLiteTable = class + private + fResults: TList; + fRowCount: Cardinal; + fColCount: Cardinal; + fCols: TStringList; + fColTypes: TList; + fRow: Cardinal; + + function GetFields(I: Integer): string; + function GetEOF: Boolean; + function GetBOF: Boolean; + function GetColumns(I: Integer): string; + function GetFieldByName(FieldName: string): string; + function GetFieldIndex(FieldName: string): integer; + function GetCount: Integer; + function GetCountResult: Integer; + + + public + constructor Create(DB: TSQLiteDatabase; const SQL: string); + destructor Destroy; override; + function FieldAsInteger(FieldName: string): integer; + function FieldAsBool(FieldName: string): boolean; + function FieldAsBlob(FieldName: string): TMemoryStream; + function FieldAsBlobText(FieldName: string): string; + function FieldIsNull(FieldName: string): boolean; + function FieldAsString(FieldName: string): string; + function FieldAsDouble(FieldName: string): double; +{ function FieldAsInteger(I: integer): integer; + function FieldAsBool(I: integer): boolean; + function FieldAsBlob(I: Integer): TMemoryStream; + function FieldAsBlobText(I: Integer): string; + function FieldIsNull(I: integer): boolean; + function FieldAsString(I: Integer): string; + function FieldAsDouble(I: Integer): double; +} function Next: Boolean; + function Previous: Boolean; + property EOF: Boolean read GetEOF; + property BOF: Boolean read GetBOF; + property Fields[I: Integer]: string read GetFields; + property FieldByName[FieldName: string]: string read GetFieldByName; + property FieldIndex[FieldName: string]: integer read GetFieldIndex; + property Columns[I: Integer]: string read GetColumns; + property ColCount: Cardinal read fColCount; + property RowCount: Cardinal read fRowCount; + property Row: Cardinal read fRow; + function MoveFirst: boolean; + function MoveLast: boolean; + + + property Count: Integer read GetCount; + + // The property CountResult is used when you execute count(*) queries. + // It returns 0 if the result set is empty or the value of the + // first field as an integer. + property CountResult: Integer read GetCountResult; + end; + + +procedure DisposePointer(ptr: pointer); cdecl; + +implementation + +uses + strutils; + + +procedure DisposePointer(ptr: pointer); cdecl; +begin + + if assigned(ptr) then + begin freemem(ptr) end; + +end; + +//------------------------------------------------------------------------------ +// TSQLiteDatabase +//------------------------------------------------------------------------------ + +constructor TSQLiteDatabase.Create(const FileName: string); +var + Msg: pchar; + iResult: integer; +begin + inherited Create; + + self.fInTrans := false; + + Msg := nil; + try + iResult := SQLite3_Open(PChar(FileName), Fdb); + + if iResult <> SQLITE_OK then + begin + if Assigned(Fdb) then + begin + Msg := Sqlite3_ErrMsg(Fdb); + raise ESqliteException.CreateFmt('Failed to open database "%s" : %s', [FileName, Msg]); + end + else + begin raise ESqliteException.CreateFmt('Failed to open database "%s" : unknown error', [FileName]) end; + end; + + //set a few configs + self.ExecSQL('PRAGMA SYNCHRONOUS=NORMAL;'); + + //this pragma not recommended and may disappear in future + //sqlite versions + //self.ExecSQL('PRAGMA full_column_names = 1;'); + + finally + if Assigned(Msg) then + begin SQLite3_Free(Msg) end; + end; + + +end; + + +//.............................................................................. + +destructor TSQLiteDatabase.Destroy; +begin + + if self.fInTrans then + begin self.ExecSQL('ROLLBACK;') end; //assume rollback + + if Assigned(fDB) then + begin SQLite3_Close(fDB) end; + + inherited; +end; + +function TSQLiteDatabase.GetLastInsertRowID: int64; +begin + result := Sqlite3_LastInsertRowID(self.fDB); +end; + +//.............................................................................. + +procedure TSQLiteDatabase.RaiseError(s: string; SQL: string); +//look up last error and raise and exception with an appropriate message +var + Msg: PChar; +begin + + Msg := nil; + + if sqlite3_errcode(self.fDB) <> SQLITE_OK then + Msg := sqlite3_errmsg(self.fDB); + + if Msg <> nil then + raise ESqliteException.CreateFmt(s + ' "%s" : %s', [SQL, Msg]) + else + raise ESqliteException.CreateFmt(s, [SQL, 'No message']); + +end; + +procedure TSQLiteDatabase.ExecSQL(const SQL: string); +var + Stmt: TSQLiteStmt; + NextSQLStatement: Pchar; + iStepResult: integer; +begin + try + + if Sqlite3_Prepare(self.fDB, PChar(SQL), -1, Stmt, NextSQLStatement) <> SQLITE_OK then + begin RaiseError('Error executing SQL', SQL) end; + + if (Stmt = nil) then + begin RaiseError('Could not prepare SQL statement', SQL) end; + + iStepResult := Sqlite3_step(Stmt); + + if (iStepResult <> SQLITE_DONE) then + begin RaiseError('Error executing SQL statement', SQL) end; + + finally + + if Assigned(Stmt) then + begin Sqlite3_Finalize(stmt) end; + + end; +end; + +procedure TSQLiteDatabase.UpdateBlob(const SQL: string; BlobData: TStream); +var + iSize: integer; + ptr: pointer; + Stmt: TSQLiteStmt; + Msg: Pchar; + NextSQLStatement: Pchar; + iStepResult: integer; + iBindResult: integer; +begin +//expects SQL of the form 'UPDATE MYTABLE SET MYFIELD = ? WHERE MYKEY = 1' + + if pos('?', SQL) = 0 then + begin RaiseError('SQL must include a ? parameter', SQL) end; + + Msg := nil; + try + + if Sqlite3_Prepare(self.fDB, PChar(SQL), -1, Stmt, NextSQLStatement) <> SQLITE_OK then + begin RaiseError('Could not prepare SQL statement', SQL) end; + + if (Stmt = nil) then + begin RaiseError('Could not prepare SQL statement', SQL) end; + +//now bind the blob data + iSize := BlobData.size; + + GetMem(ptr, iSize); + + if (ptr = nil) then + begin raise ESqliteException.CreateFmt('Error getting memory to save blob', [SQL, 'Error']) end; + + BlobData.position := 0; + BlobData.Read(ptr^, iSize); + + iBindResult := SQLite3_BindBlob(stmt, 1, ptr, iSize, @DisposePointer); + + if iBindResult <> SQLITE_OK then + begin RaiseError('Error binding blob to database', SQL) end; + + iStepResult := Sqlite3_step(Stmt); + + if (iStepResult <> SQLITE_DONE) then + begin RaiseError('Error executing SQL statement', SQL) end; + + finally + + if Assigned(Stmt) then + begin Sqlite3_Finalize(stmt) end; + + if Assigned(Msg) then + begin SQLite3_Free(Msg) end; + end; + +end; + +//.............................................................................. + +function TSQLiteDatabase.GetTable(const SQL: string): TSQLiteTable; +begin + Result := TSQLiteTable.Create(Self, SQL); +end; + +procedure TSQLiteDatabase.BeginTransaction; +begin + if not self.fInTrans then + begin + self.ExecSQL('BEGIN TRANSACTION;'); + self.fInTrans := true; + end + else + begin raise ESqliteException.Create('Transaction already open') end; +end; + +procedure TSQLiteDatabase.Commit; +begin + self.ExecSQL('COMMIT;'); + self.fInTrans := false; +end; + +procedure TSQLiteDatabase.Rollback; +begin + self.ExecSQL('ROLLBACK;'); + self.fInTrans := false; +end; + +function TSQLiteDatabase.TableExists(TableName: string): boolean; +var + sql: string; + ds: TSqliteTable; +begin +//returns true if table exists in the database + sql := 'select [sql] from sqlite_master where [type] = ''table'' and lower(name) = ''' + lowercase(TableName) + ''' '; + + try + + ds := self.GetTable(sql); + + result := (ds.Count > 0); + + finally + + freeandnil(ds); + + end; + +end; + + +//------------------------------------------------------------------------------ +// TSQLiteTable +//------------------------------------------------------------------------------ + +constructor TSQLiteTable.Create(DB: TSQLiteDatabase; const SQL: string); +var + Stmt: TSQLiteStmt; + NextSQLStatement: Pchar; + iStepResult: integer; + + ptr: pointer; + iNumBytes: integer; + thisBlobValue: TMemoryStream; + thisStringValue: pstring; + thisBoolValue: pBoolean; + thisDoubleValue: pDouble; + thisIntValue: pInteger; + thisColType: pInteger; + i: integer; + DeclaredColType: Pchar; + ActualColType: integer; + ptrValue: Pchar; + +begin + + try + + self.fRowCount := 0; + self.fColCount := 0; + +//if there are several SQL statements in SQL, NextSQLStatment points to the +//beginning of the next one. Prepare only prepares the first SQL statement. + + if Sqlite3_Prepare(Db.fDB, PChar(SQL), -1, Stmt, NextSQLStatement) <> SQLITE_OK then + begin Db.RaiseError('Error executing SQL', SQL) end; + + if (Stmt = nil) then + begin Db.RaiseError('Could not prepare SQL statement', SQL) end; + + iStepResult := Sqlite3_step(Stmt); + + while (iStepResult <> SQLITE_DONE) do + begin + + case iStepResult of + SQLITE_ROW: + begin + + inc(fRowCount); + + if (fRowCount = 1) then + begin + //get data types + fCols := TStringList.Create; + fCols.CaseSensitive := False; + fColTypes := TList.Create; + + fColCount := SQLite3_ColumnCount(stmt); + + for i := 0 to Pred(fColCount) do + begin + fCols.Add(Sqlite3_ColumnName(stmt, i)); + end; + + for i := 0 to Pred(fColCount) do + begin + + new(thisColType); + DeclaredColType := Sqlite3_ColumnDeclType(stmt, i); + + if DeclaredColType = nil then begin + //use the actual column type instead + //seems to be needed for last_insert_rowid + thisColType^ := Sqlite3_ColumnType(stmt, i); + end else begin + DeclaredColType := strupper(DeclaredColType); + + if DeclaredColType = 'INTEGER' then + begin thisColType^ := dtInt end + else + if DeclaredColType = 'BOOLEAN' then + begin thisColType^ := dtBool end + else + if (DeclaredColType = 'NUMERIC') or (DeclaredColType = 'FLOAT') or (DeclaredColType = 'DOUBLE') then + begin thisColType^ := dtNumeric end + else + if DeclaredColType = 'BLOB' then + begin thisColType^ := dtBlob end + else + begin thisColType^ := dtStr end; + end; + + fColTypes.Add(thiscoltype); + end; + + fResults := TList.Create; + + end; + + //get column values + for i := 0 to Pred(ColCount) do + begin + + ActualColType := Sqlite3_ColumnType(stmt, i); + if (ActualColType = SQLITE_NULL) then + begin fResults.Add(nil) end + else + begin + if pInteger(fColTypes[i])^ = dtInt then + begin + new(thisintvalue); + thisintvalue^ := Sqlite3_ColumnInt(stmt, i); + fResults.Add(thisintvalue); + end + else + if pInteger(fColTypes[i])^ = dtBool then + begin + new(thisboolvalue); + thisboolvalue^ := not (Sqlite3_ColumnInt(stmt, i) = 0); + fResults.Add(thisboolvalue); + end + else + if pInteger(fColTypes[i])^ = dtNumeric then + begin + new(thisdoublevalue); + thisdoublevalue^ := Sqlite3_ColumnDouble(stmt, i); + fResults.Add(thisdoublevalue); + end + else + if pInteger(fColTypes[i])^ = dtBlob then + begin + iNumBytes := Sqlite3_ColumnBytes(stmt, i); + + if iNumBytes = 0 then + begin thisblobvalue := nil end + else + begin + thisblobvalue := TMemoryStream.Create; + thisblobvalue.position := 0; + ptr := Sqlite3_ColumnBlob(stmt, i); + thisblobvalue.writebuffer(ptr^, iNumBytes); + end; + fResults.Add(thisblobvalue); + + end + else + begin + new(thisstringvalue); + ptrValue := Sqlite3_ColumnText(stmt, i); + setstring(thisstringvalue^, ptrvalue, strlen(ptrvalue)); + fResults.Add(thisstringvalue); + end; + end; + + end; + + + + end; + + SQLITE_BUSY: + begin raise ESqliteException.CreateFmt('Could not prepare SQL statement', [SQL, 'SQLite is Busy']) end; + else + begin Db.RaiseError('Could not retrieve data', SQL) end; + end; + + iStepResult := Sqlite3_step(Stmt); + + end; + + fRow := 0; + + finally + if Assigned(Stmt) then + begin Sqlite3_Finalize(stmt) end; + end; + +end; + +//.............................................................................. + +destructor TSQLiteTable.Destroy; +var i: integer; + iColNo: integer; +begin + + + if Assigned(fResults) then + begin for i := 0 to fResults.Count - 1 do + begin + //check for blob type + iColNo := (i mod fColCount); + case pInteger(self.fColTypes[iColNo])^ of + dtBlob: + begin + TMemoryStream(fResults[i]).free; + end; + dtStr: + begin + if fResults[i] <> nil then + begin + setstring(string(fResults[i]^), nil, 0); + dispose(fResults[i]); + end; + end; + else + begin + dispose(fResults[i]) + end; + end; + end; + fResults.Free; + end; + + if Assigned(fCols) then + begin fCols.Free end; + + if Assigned(fColTypes) then + begin for i := 0 to fColTypes.Count - 1 do + begin + dispose(fColTypes[i]); + end end; + fColTypes.Free; + inherited; + end; + +//.............................................................................. + +function TSQLiteTable.GetColumns(I: Integer): string; +begin + Result := fCols[I]; +end; + +//.............................................................................. + +function TSQLiteTable.GetCountResult: Integer; +begin + if not EOF then + begin Result := StrToInt(Fields[0]) end + else + begin Result := 0 end; +end; + +function TSQLiteTable.GetCount: Integer; +begin + Result := FRowCount; +end; + +//.............................................................................. + +function TSQLiteTable.GetEOF: Boolean; +begin + Result := fRow >= fRowCount; +end; + +function TSQLiteTable.GetBOF: Boolean; +begin + Result := fRow <= 0; +end; + +//.............................................................................. + +function TSQLiteTable.GetFieldByName(FieldName: string): string; +begin + Result := GetFields(self.GetFieldIndex(FieldName)); +end; + +function TSQLiteTable.GetFieldIndex(FieldName: string): integer; +begin + + if (fCols = nil) then + begin + raise ESqliteException.Create('Field ' + fieldname + ' Not found. Empty dataset'); + exit; + end; + + if (fCols.count = 0) then + begin + raise ESqliteException.Create('Field ' + fieldname + ' Not found. Empty dataset'); + exit; + end; + + result := fCols.IndexOf(FieldName); + + if (result < 0) then + begin raise ESqliteException.Create('Field not found in dataset: ' + fieldname) end; + +end; + +//.............................................................................. + +function TSQLiteTable.GetFields(I: Integer): string; +var + thisvalue: pstring; + ptr: pointer; + thisboolvalue: pBoolean; + thistype: integer; +begin + Result := ''; + + if EOF then + begin raise ESqliteException.Create('Table is at End of File') end; + +//integer and boolean types are not stored in the resultset +//as strings, so they should be retrieved using the type-specific +//methods + + thistype := pInteger(self.fColTypes[I])^; + + if (thistype = dtInt) or (thistype = dtNumeric) or (thistype = dtBlob) then + begin + ptr := self.fResults[(self.frow * self.fColCount) + I]; + + if ptr <> nil then + begin + raise ESqliteException.Create('Use the specific methods for integer, numeric or blob fields'); + end; + + end + else + if pInteger(self.fColTypes[I])^ = dtBool then + begin + thisboolvalue := self.fResults[(self.frow * self.fColCount) + I]; + if thisboolvalue <> nil then + begin if thisboolvalue^ then + begin result := '1' end + else + begin result := '0' end end; + end + + else + + begin + + thisvalue := self.fResults[(self.frow * self.fColCount) + I]; + if (thisvalue <> nil) then + begin Result := thisvalue^ end + else + begin Result := '' end; //return empty string + end; + +end; + +function TSqliteTable.FieldAsBlob(FieldName: string): TMemoryStream; +var + i: Integer; +begin + + if EOF then + begin raise ESqliteException.Create('Table is at End of File') end; + + i:=Self.FieldIndex[FieldName]; + + if (self.fResults[(self.frow * self.fColCount) + I] = nil) then + begin result := nil end + else + if pInteger(self.fColTypes[I])^ = dtBlob then + begin result := TMemoryStream(self.fResults[(self.frow * self.fColCount) + I]) end + else + begin raise ESqliteException.Create('Not a Blob field') end; +end; + +function TSqliteTable.FieldAsBlobText(FieldName: string): string; +var + MemStream: TMemoryStream; + Buffer: PChar; +begin + result := ''; + + MemStream := self.FieldAsBlob(FieldName); + + if MemStream <> nil then + begin if MemStream.Size > 0 then + begin + MemStream.position := 0; + + Buffer := stralloc(MemStream.Size + 1); + MemStream.readbuffer(Buffer[0], MemStream.Size); + (Buffer + MemStream.Size)^ := chr(0); + SetString(Result, Buffer, MemStream.size); + strdispose(Buffer); + end end; + +end; + + +function TSqliteTable.FieldAsInteger(FieldName: string): integer; +var + i: Integer; +begin + + if EOF then + begin raise ESqliteException.Create('Table is at End of File') end; + + i:=Self.FieldIndex[FieldName]; + + if (self.fResults[(self.frow * self.fColCount) + I] = nil) then + begin result := 0 end + else + if pInteger(self.fColTypes[I])^ = dtInt then + begin result := pInteger(self.fResults[(self.frow * self.fColCount) + I])^ end + else + if pInteger(self.fColTypes[I])^ = dtNumeric then + begin result := trunc(strtofloat(pString(self.fResults[(self.frow * self.fColCount) + I])^)) end + else + begin raise ESqliteException.Create('Not an integer or numeric field') end; + +end; + +function TSqliteTable.FieldAsDouble(FieldName: string): double; +var + i: Integer; +begin + + if EOF then + begin raise ESqliteException.Create('Table is at End of File') end; + + i:=Self.FieldIndex[FieldName]; + + if (self.fResults[(self.frow * self.fColCount) + I] = nil) then + begin result := 0 end + else + if pInteger(self.fColTypes[I])^ = dtInt then + begin result := pInteger(self.fResults[(self.frow * self.fColCount) + I])^ end + else + if pInteger(self.fColTypes[I])^ = dtNumeric then + begin result := pDouble(self.fResults[(self.frow * self.fColCount) + I])^ end + else + begin raise ESqliteException.Create('Not an integer or numeric field') end; + +end; + +function TSqliteTable.FieldAsBool(FieldName: string): boolean; +var + i: Integer; +begin + + if EOF then + begin raise ESqliteException.Create('Table is at End of File') end; + + i:=Self.FieldIndex[FieldName]; + + if (self.fResults[(self.frow * self.fColCount) + I] = nil) then + begin result := false end + else + if pInteger(self.fColTypes[I])^ = dtBool then + begin result := pBoolean(self.fResults[(self.frow * self.fColCount) + I])^ end + else + begin raise ESqliteException.Create('Not a boolean field') end; +end; + +function TSqliteTable.FieldAsString(FieldName: string): string; +var + i: Integer; +begin + + if EOF then + begin raise ESqliteException.Create('Table is at End of File') end; + + i:=Self.FieldIndex[FieldName]; + + if (self.fResults[(self.frow * self.fColCount) + I] = nil) then + begin result := '' end + else + begin result := self.GetFields(I) end; + +end; + +function TSqliteTable.FieldIsNull(FieldName: string): boolean; +var + thisvalue: pointer; + i: Integer; +begin + + if EOF then + begin raise ESqliteException.Create('Table is at End of File') end; + + i:=Self.FieldIndex[FieldName]; + + thisvalue := self.fResults[(self.frow * self.fColCount) + I]; + result := (thisvalue = nil); +end; + +//.............................................................................. + +function TSQLiteTable.Next: boolean; +begin + result := false; + if not EOF then + begin + Inc(fRow); + result := true; + end; +end; + +function TSQLiteTable.Previous: boolean; +begin + result := false; + if not BOF then + begin + Dec(fRow); + result := true; + end; +end; + +function TSQLiteTable.MoveFirst: boolean; +begin + result := false; + if self.fRowCount > 0 then + begin + fRow := 0; + result := true; + end; +end; + +function TSQLiteTable.MoveLast: boolean; +begin + result := false; + if self.fRowCount > 0 then + begin + fRow := fRowCount - 1; + result := true; + end; +end; + + +end. + Index: /oup/releases/0.18a2/Unit1_main.dfm =================================================================== --- /oup/releases/0.18a2/Unit1_main.dfm (revision 21) +++ /oup/releases/0.18a2/Unit1_main.dfm (revision 21) @@ -0,0 +1,148 @@ +object Form1: TForm1 + Left = 0 + Top = 0 + HorzScrollBar.Visible = False + VertScrollBar.Visible = False + AutoScroll = False + Caption = 'Form1' + ClientHeight = 544 + ClientWidth = 692 + Color = clBtnFace + Font.Charset = DEFAULT_CHARSET + Font.Color = clWindowText + Font.Height = -11 + Font.Name = 'Tahoma' + Font.Style = [] + FormStyle = fsMDIForm + Menu = menu + OldCreateOrder = False + OnClose = FormClose + OnCreate = FormCreate + OnResize = FormResize + PixelsPerInch = 96 + TextHeight = 13 + object statbar: TStatusBar + Left = 0 + Top = 527 + Width = 692 + Height = 17 + BiDiMode = bdLeftToRight + Panels = < + item + Text = 'Current .dat: -' + Width = 500 + end + item + Text = 'Files: -' + Width = 90 + end + item + Text = 'Extensions: -' + Width = 100 + end> + ParentBiDiMode = False + end + object tabs: TTabSet + Left = 0 + Top = 507 + Width = 692 + Height = 20 + Align = alBottom + DitherBackground = False + Font.Charset = DEFAULT_CHARSET + Font.Color = clWindowText + Font.Height = -11 + Font.Name = 'Tahoma' + Font.Style = [] + SoftTop = True + Style = tsModernTabs + OnChange = tabsChange + end + object fopen: TOpenDialog + Filter = 'Oni-Dat-Files|*.dat|Oni-Sep-Files (MAC)|*.sep' + Left = 480 + end + object menu: TMainMenu + AutoHotkeys = maManual + Left = 592 + object menu_main: TMenuItem + Caption = '&Main' + object menu_loaddat: TMenuItem + Caption = '&Select .dat-file ...' + ShortCut = 16463 + OnClick = menu_loaddatClick + end + object menu_sep1: TMenuItem + Caption = '-' + end + object menu_exit: TMenuItem + Caption = '&Exit' + OnClick = menu_exitClick + end + end + object menu_extract: TMenuItem + Caption = '&Extract/Convert' + Enabled = False + Visible = False + object menu_extractfile: TMenuItem + Caption = 'Convert and extract current &file' + end + object menu_extractlist: TMenuItem + Caption = 'Convert and extract all files currently in &list' + end + object menu_extractall: TMenuItem + Caption = 'Convert and extract &all files' + end + end + object menu_tools: TMenuItem + Caption = '&Tools' + Enabled = False + object menu_preview: TMenuItem + Caption = '&Preview Window ...' + ShortCut = 16464 + OnClick = menu_previewClick + end + object menu_binedit: TMenuItem + Caption = '&Binary .dat editor ...' + ShortCut = 16450 + OnClick = menu_bineditClick + end + object menu_txmpreplace: TMenuItem + Caption = '&TXMP replacer ...' + ShortCut = 16468 + OnClick = menu_txmpreplaceClick + end + end + object menu_windows: TMenuItem + Caption = '&Windows' + object menu_windows_cascade: TMenuItem + Caption = 'Cascade' + OnClick = menu_windows_cascadeClick + end + object menu_windows_tile: TMenuItem + Caption = 'Tile' + OnClick = menu_windows_tileClick + end + object menu_windows_closeall: TMenuItem + Caption = '&Close all' + OnClick = menu_windows_closeallClick + end + object menu_sep3: TMenuItem + Caption = '-' + end + object menu_windows_next: TMenuItem + Caption = 'Next window' + ShortCut = 16417 + OnClick = menu_windows_nextClick + end + object menu_windows_previous: TMenuItem + Caption = 'Previous window' + ShortCut = 16418 + OnClick = menu_windows_previousClick + end + object menu_sep2: TMenuItem + Caption = '-' + end + end + end +end Index: /oup/releases/0.18a2/Unit1_main.pas =================================================================== --- /oup/releases/0.18a2/Unit1_main.pas (revision 21) +++ /oup/releases/0.18a2/Unit1_main.pas (revision 21) @@ -0,0 +1,370 @@ +UNIT Unit1_main; +INTERFACE +USES + Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, + Dialogs, StdCtrls, StrUtils, Clipbrd, ExtCtrls, ComCtrls, Menus, + Unit2_functions, Unit3_data, Unit5_preview, Unit7_txmpreplace, Unit8_binedit, + Grids, MPHexEditor, ToolWin, ImgList, Tabs; + +TYPE + TForm1 = Class(TForm) + fopen: TOpenDialog; + menu: TMainMenu; + menu_main: TMenuItem; + menu_exit: TMenuItem; + menu_preview: TMenuItem; + menu_tools: TMenuItem; + menu_txmpreplace: TMenuItem; + menu_extract: TMenuItem; + menu_extractfile: TMenuItem; + menu_extractlist: TMenuItem; + menu_extractall: TMenuItem; + menu_loaddat: TMenuItem; + menu_sep1: TMenuItem; + menu_binedit: TMenuItem; + statbar: TStatusBar; + menu_windows: TMenuItem; + menu_windows_cascade: TMenuItem; + menu_windows_closeall: TMenuItem; + menu_sep2: TMenuItem; + menu_windows_tile: TMenuItem; + menu_sep3: TMenuItem; + menu_windows_next: TMenuItem; + menu_windows_previous: TMenuItem; + tabs: TTabSet; + PROCEDURE SetActiveWindow(window_name:String); + PROCEDURE tabsChange(Sender: TObject; NewTab: Integer; var AllowChange: Boolean); + PROCEDURE close_window(window_name:String); + PROCEDURE menu_windows_previousClick(Sender: TObject); + PROCEDURE menu_windows_nextClick(Sender: TObject); + PROCEDURE menu_windows_tileClick(Sender: TObject); + PROCEDURE open_child(window_context:String); + PROCEDURE menu_windows_closeallClick(Sender: TObject); + PROCEDURE menu_windows_cascadeClick(Sender: TObject); + PROCEDURE menu_window_entryClick(Sender: TObject); + PROCEDURE menu_bineditClick(Sender: TObject); + PROCEDURE menu_loaddatClick(Sender: TObject); + PROCEDURE menu_txmpreplaceClick(Sender: TObject); + PROCEDURE menu_exitClick(Sender: TObject); + PROCEDURE menu_previewClick(Sender: TObject); + PROCEDURE FormClose(Sender: TObject; var Action: TCloseAction); + PROCEDURE FormResize(Sender: TObject); + PROCEDURE FormCreate(Sender: TObject); + PRIVATE + PUBLIC + END; + +VAR + Form1: TForm1; + +IMPLEMENTATION +{$R *.dfm} +VAR + tablist:Array OF String; + +PROCEDURE LoadDat; + VAR i:LongWord; + BEGIN + Form1.fopen.InitialDir:=AppSettings.DatPath; + IF Form1.fopen.Execute THEN BEGIN + Form1.Caption:='Oni Un/Packer '+version+' ('+ExtractFileName(Form1.fopen.FileName)+')'; + AppSettings.DatPath:=ExtractFilepath(Form1.fopen.FileName); + IF LoadDatInfos(Form1.fopen.FileName) THEN BEGIN + Form1.statbar.Panels.Items[0].Text:='Current .dat: '+dat_FileName; + Form1.statbar.Panels.Items[1].Text:='Files: '+IntToStr(dat_header.Files); + Form1.statbar.Panels.Items[2].Text:='Extensions: '+IntToStr(dat_header.Extensions); + Form1.menu_tools.Enabled:=True; + Form1.menu_extract.Enabled:=True; + + IF Form1.MDIChildCount>0 THEN + FOR i:=0 TO Form1.MDIChildCount-1 DO BEGIN + IF Pos('binedit',Form1.MDIChildren[i].Name)>0 THEN + TForm8(Form1.MDIChildren[i]).Recreatelist; + IF Pos('preview',Form1.MDIChildren[i].Name)>0 THEN + TForm5(Form1.MDIChildren[i]).Recreatelist; + IF Pos('txmpreplace',Form1.MDIChildren[i].Name)>0 THEN + TForm7(Form1.MDIChildren[i]).Recreatelist; + END; + END ELSE BEGIN + ShowMessage('Error while loading the file:'+CrLf+Form1.fopen.FileName+CrLf+'Perhaps not an Oni-.dat-file?'); + END; + END; + END; + +PROCEDURE TForm1.FormCreate(Sender: TObject); + BEGIN + Form1.Caption:='Oni Un/Packer '+version; + Form1.FormResize(Form1); + + IF FileExists(ExtractFilepath(Application.EXEname)+'\oniunpacker.ini') THEN BEGIN + AssignFile(AppSettingsFile,ExtractFilepath(Application.EXEname)+'\oniunpacker.ini'); + Reset(AppSettingsFile); + Read(AppSettingsFile,AppSettings); + CloseFile(AppSettingsFile); + END ELSE BEGIN + AppSettings.DatPath:='D:\Spiele\Oni\GameDataFolder'; + AppSettings.ExtractPath:='C:\Dokumente und Einstellungen\Administrator\Desktop'; + END; + END; + +PROCEDURE TForm1.FormResize(Sender: TObject); + CONST + MinWidth:Integer=750; + MinHeight:Integer=500; + BEGIN + IF Form1.Width0 THEN BEGIN + FOR i:=0 TO MDIChildCount-1 DO BEGIN + MDIChildren[i].Close; + END; + END; + tabs.Tabs.Clear; + END; +PROCEDURE TForm1.menu_windows_nextClick(Sender: TObject); + VAR i:Byte; + first_window:Byte; + current_focus:String; + BEGIN + IF MDIChildCount>1 THEN BEGIN + FOR i:=0 TO menu_windows.Count-1 DO BEGIN + IF Pos('menu_window_',menu_windows.Items[i].Name)=1 THEN BEGIN + first_window:=i; + Break; + END; + END; + current_focus:=ActiveMDIChild.Name; + FOR i:=first_window TO menu_windows.Count-1 DO + IF Pos(current_focus,menu_windows.Items[i].Name)>0 THEN + Break; + IF i=menu_windows.Count-1 THEN + menu_windows.Items[first_window].Click + ELSE + menu_windows.Items[i+1].Click; + FOR i:=0 TO High(tablist) DO BEGIN + IF tablist[i]=ActiveMDIChild.Name THEN BEGIN + tabs.TabIndex:=i; + END; + END; + END; + END; +PROCEDURE TForm1.menu_windows_previousClick(Sender: TObject); + VAR i:Byte; + first_window:Byte; + current_focus:String; + BEGIN + IF MDIChildCount>1 THEN BEGIN + FOR i:=0 TO menu_windows.Count-1 DO BEGIN + IF Pos('menu_window_',menu_windows.Items[i].Name)=1 THEN BEGIN + first_window:=i; + Break; + END; + END; + current_focus:=ActiveMDIChild.Name; + FOR i:=first_window TO menu_windows.Count-1 DO + IF Pos(current_focus,menu_windows.Items[i].Name)>0 THEN + Break; + IF i=first_window THEN + menu_windows.Items[menu_windows.Count-1].Click + ELSE + menu_windows.Items[i-1].Click; + FOR i:=0 TO High(tablist) DO BEGIN + IF tablist[i]=ActiveMDIChild.Name THEN BEGIN + tabs.TabIndex:=i; + END; + END; + END; + END; + +PROCEDURE TForm1.menu_window_entryClick(Sender: TObject); + VAR + i:Byte; + window_name:String; + BEGIN + window_name:=MidStr(TComponent(Sender).Name,Pos('window_',TComponent(Sender).Name)+7,Length(TComponent(Sender).Name)-Pos('window_',TComponent(Sender).Name)+7+1); + FOR i:=0 TO MDIChildCount-1 DO BEGIN + IF MDIChildren[i].Name=window_name THEN BEGIN + MDIChildren[i].BringToFront; + END; + END; + FOR i:=0 TO High(tablist) DO BEGIN + IF tablist[i]=ActiveMDIChild.Name THEN BEGIN + tabs.TabIndex:=i; + END; + END; + END; + + + +PROCEDURE TForm1.open_child(window_context:String); + VAR + binEdit:TForm8; + preview:TForm5; + txmpreplacer:TForm7; + menu_button:TMenuItem; + used:Array[1..9] OF Boolean; + i:Byte; + caption:String; + name:String; + BEGIN + FOR i:=1 TO 9 DO used[i]:=False; + IF MDIChildCount>0 THEN + FOR i:=0 TO MDIChildCount-1 DO + IF Pos(window_context,Form1.MDIChildren[i].Name)=1 THEN + used[StrToInt(RightStr(Form1.MDIChildren[i].Caption,1))]:=True; + FOR i:=1 TO 10 DO + IF i=10 THEN + Break + ELSE + IF NOT used[i] THEN Break; + + IF i<10 THEN BEGIN + name:=window_context+IntToStr(i); + IF window_context='binedit' THEN + caption:='Binary .dat-Editor '+IntToStr(i); + IF window_context='preview' THEN + caption:='Preview-Window '+IntToStr(i); + IF window_context='txmpreplace' THEN + caption:='TXMP Replacer '+IntToStr(i); + + menu_button:=TMenuItem.Create(menu_windows); + menu_button.Caption:=caption; + menu_button.Name:='menu_window_'+name; + menu_button.OnClick:=Form1.menu_window_entryClick; + menu_windows.Add(menu_button); + + SetLength(tablist,Length(tablist)+1); + tablist[High(tablist)]:=name; + tabs.Tabs.Add(caption); + + IF window_context='binedit' THEN BEGIN + binEdit:=TForm8.Create(Application); + binEdit.Name:=name; + binEdit.Caption:=caption; + binEdit.Recreatelist; + END; + IF window_context='preview' THEN BEGIN + preview:=TForm5.Create(Application); + preview.Name:=name; + preview.Caption:=caption; + preview.Recreatelist; + END; + IF window_context='txmpreplace' THEN BEGIN + txmpreplacer:=TForm7.Create(Application); + txmpreplacer.Name:=name; + txmpreplacer.Caption:=caption; + txmpreplacer.Recreatelist; + END; + + tabs.TabIndex:=High(tablist); + IF MDIChildCount=9 THEN menu_tools.Enabled:=False; + END; + END; + + +PROCEDURE TForm1.close_window(window_name:String); + VAR + i,j:Byte; + BEGIN + FOR i:=0 TO menu_windows.Count-1 DO BEGIN + IF menu_windows.Items[i].Name='menu_window_'+window_name THEN BEGIN + menu_windows.Items[i].Free; + Break; + END; + END; + FOR i:=0 TO High(tablist) DO BEGIN + IF tablist[i]=window_name THEN BEGIN + tabs.Tabs.Delete(i); + IF High(tablist)>0 THEN + FOR j:=i TO High(tablist)-1 DO + tablist[j]:=tablist[j+1]; + SetLength(tablist,Length(tablist)-1); + Break; + END; + END; + menu_tools.Enabled:=True; + END; + + +PROCEDURE TForm1.tabsChange(Sender: TObject; NewTab: Integer; var AllowChange: Boolean); + VAR + i:Byte; + BEGIN + FOR i:=0 TO MDIChildCount-1 DO BEGIN + IF MDIChildren[i].Name=tablist[NewTab] THEN + MDIChildren[i].BringToFront; + END; + END; + +PROCEDURE TForm1.SetActiveWindow(window_name:String); + VAR + i:Byte; + BEGIN + IF Length(tablist)>0 THEN + FOR i:=0 TO High(tablist) DO + IF tablist[i]=window_name THEN + tabs.TabIndex:=i; + END; + + +END. Index: /oup/releases/0.18a2/Unit2_functions.pas =================================================================== --- /oup/releases/0.18a2/Unit2_functions.pas (revision 21) +++ /oup/releases/0.18a2/Unit2_functions.pas (revision 21) @@ -0,0 +1,255 @@ +UNIT Unit2_functions; +INTERFACE +USES Classes, SysUtils, StrUtils, Math, SQLiteTable3, Unit3_data, Unit4_Exporters; + +FUNCTION Decode_Int(buffer:Tdata):LongWord; +FUNCTION Encode_Int(input:LongWord):Tdata; +FUNCTION Decode_Float(buffer:Tdata):Single; +FUNCTION Encode_Float(input:Single):Tdata; +FUNCTION LoadDatInfos(filename:String):Boolean; +FUNCTION LoadDatFile(fileid:LongWord):Tdata; +PROCEDURE SaveDatFile(fileid:LongWord; data:Tdata); +FUNCTION LoadDatFilePart(fileid,offset,size:LongWord; target:Pointer):Boolean; +FUNCTION LoadRawFilePart(address,size:LongWord; target:Pointer):Boolean; +FUNCTION FormatNumber(value:LongWord; width:Byte; leadingzeros:Char):String; +FUNCTION FormatFileSize(size:LongWord):String; +FUNCTION CreateHexString(data:Tdata; HexOnly:Boolean):String; +FUNCTION ExportFile(fileid:LongWord; convert:Boolean):Integer; +FUNCTION GetWinFileName(fileid:LongWord; substring:String):String; +FUNCTION GetExtractPath:String; + + + +IMPLEMENTATION + +TYPE + TValueSwitcher=Record + CASE IsFloat: Boolean OF + True: (ValueFloat:Single); + False: (ValueInt:LongWord); + END; + + +FUNCTION Decode_Int(buffer:Tdata):LongWord; + BEGIN + Result:=buffer[0]+buffer[1]*256+buffer[2]*256*256+buffer[3]*256*256*256; + END; +FUNCTION Encode_Int(input:LongWord):Tdata; + BEGIN + Result[0]:=input MOD 256; + input:=input DIV 256; + Result[1]:=input MOD 256; + input:=input DIV 256; + Result[2]:=input MOD 256; + input:=input DIV 256; + Result[3]:=input MOD 256; + END; +FUNCTION Decode_Float(buffer:Tdata):Single; + VAR _valueswitcher:TValueSwitcher; + BEGIN + _valueswitcher.ValueInt:=Decode_Int(buffer); + Result:=_valueswitcher.ValueFloat; + END; +FUNCTION Encode_Float(input:Single):Tdata; + VAR _valueswitcher:TValueSwitcher; + BEGIN + _valueswitcher.ValueFloat:=input; + Result:=Encode_Int(_valueswitcher.ValueInt); + END; + + +FUNCTION LoadDatInfos(filename:String):Boolean; + VAR i:LongWord; + dat_file:TFileStream; + BEGIN + Result:=True; + dat_filename:=filename; + raw_filename:=MidStr(filename,1,Length(filename)-3)+'raw'; + dat_file:=TFileStream.Create(filename, fmOpenRead); + dat_file.Read(dat_header,SizeOf(dat_header)); + FOR i:=0 TO High(dat_header.Ident) DO + IF dat_header.Ident[i]<>header_ident1[i] THEN BEGIN + Result:=False; + Exit; + END; +{ FOR i:=0 TO High(dat_header.Ident2) DO + IF dat_header.Ident2[i]<>header_ident2[i] THEN BEGIN + Result:=False; + Exit; + END; +} + SetLength(dat_filesmap,dat_header.Files); + SetLength(dat_files,dat_header.Files); + FOR i:=0 TO dat_header.Files-1 DO dat_file.Read(dat_filesmap[i],SizeOf(dat_filesmap[i])); + FOR i:=0 TO dat_header.Files-1 DO BEGIN + dat_files[i].Extension:=dat_filesmap[i].Extension; + dat_files[i].Extension:=ReverseString(dat_files[i].Extension); + dat_files[i].Size:=dat_filesmap[i].FileSize; + dat_files[i].FileType:=dat_filesmap[i].FileType; + dat_files[i].DatAddr:=dat_filesmap[i].DataAddr-8+dat_header.DataAddr; + IF (dat_filesmap[i].FileType AND $01)=0 THEN BEGIN + dat_file.Seek(dat_filesmap[i].NameAddr+dat_header.NamesAddr,soFromBeginning); + SetLength(dat_files[i].Name,100); + dat_file.Read(dat_files[i].Name[1],100); + dat_files[i].Name:=MidStr(dat_files[i].Name,1+4,Pos(#0,dat_files[i].Name)-1-4); + END ELSE BEGIN + dat_files[i].Name:=''; + END; + dat_files[i].FileName:=FormatNumber(i,5,'0')+'-'+dat_files[i].Name+'.'+dat_files[i].Extension; + END; + dat_file.Seek($40+dat_header.Files*$14,soFromBeginning); + SetLength(dat_namedfilesmap,dat_header.NamedFiles); + FOR i:=0 TO dat_header.NamedFiles-1 DO dat_file.Read(dat_namedfilesmap[i],SizeOf(dat_namedfilesmap[i])); + + dat_file.Seek($40+dat_header.Files*$14+dat_header.NamedFiles*$8,soFromBeginning); + SetLength(dat_extensionsmap,dat_header.Extensions); + FOR i:=0 TO dat_header.Extensions-1 DO dat_file.Read(dat_extensionsmap[i],SizeOf(dat_extensionsmap[i])); + + dat_file.Free; + END; + + +FUNCTION LoadDatFile(fileid:LongWord):Tdata; + VAR dat_file:TFileStream; + BEGIN + dat_file:=TFileStream.Create(dat_filename, fmOpenRead); + dat_file.Seek(dat_files[fileid].DatAddr,soFromBeginning); + SetLength(Result,dat_files[fileid].Size); + dat_file.Read(Result[0],dat_files[fileid].Size); + dat_file.Free; + END; + + +PROCEDURE SaveDatFile(fileid:LongWord; data:Tdata); + VAR dat_file:TFileStream; + BEGIN + dat_file:=TFileStream.Create(dat_filename, fmOpenReadWrite); + dat_file.Seek(dat_files[fileid].DatAddr,soFromBeginning); + dat_file.Write(data[0],Length(data)); + dat_file.Free; + END; + + +FUNCTION LoadDatFilePart(fileid,offset,size:LongWord; target:Pointer):Boolean; + VAR dat_file:TFileStream; + BEGIN + dat_file:=TFileStream.Create(dat_filename, fmOpenRead); + Result:=True; + dat_file.Seek(dat_files[fileid].DatAddr+offset,soFromBeginning); + dat_file.Read(target^,size); + dat_file.Free; + END; + + +FUNCTION LoadRawFilePart(address,size:LongWord; target:Pointer):Boolean; + VAR + filestream:TFileStream; + BEGIN + Result:=True; + filestream:=TFileStream.Create(AnsiReplaceStr(dat_filename,'.dat','.raw'),fmOpenRead); + filestream.Seek(address,soFromBeginning); + filestream.Read(target^,size); + filestream.Free; + END; + + +FUNCTION FormatNumber(value:LongWord; width:Byte; leadingzeros:Char):String; + BEGIN + Result:=AnsiReplaceStr(Format('%'+IntToStr(width)+'u',[value]),' ',leadingzeros); + END; + + +FUNCTION FormatFileSize(size:LongWord):String; + BEGIN + IF size>=1000*1024*1024 THEN BEGIN + Result:=FloatToStrF(size/1024/1024/1024,ffFixed,5,1)+' GB'; + END ELSE BEGIN + IF size>=1000*1024 THEN BEGIN + Result:=FloatToStrF(size/1024/1024,ffFixed,5,1)+' MB'; + END ELSE BEGIN + IF size>=1000 THEN BEGIN + Result:=FloatToStrF(size/1024,ffFixed,5,1)+' KB'; + END ELSE BEGIN + Result:=IntToStr(size)+' B'; + END; + END; + END; + END; + + +FUNCTION CreateHexString(data:Tdata; HexOnly:Boolean):String; + VAR + string_build,ascii_version:String; + i:LongWord; + BEGIN + string_build:=''; + ascii_version:=''; + FOR i:=0 TO High(data) DO BEGIN + IF NOT HexOnly THEN + IF (i MOD 16)=0 THEN + string_build:=string_build+'0x'+IntToHex(i,6)+' '; + string_build:=string_build+IntToHex(data[i],2); + IF NOT HexOnly THEN BEGIN + IF data[i]>=32 THEN ascii_version:=ascii_version+Chr(data[i]) + ELSE ascii_version:=ascii_version+'.'; + IF ((i+1) MOD 2)=0 THEN string_build:=string_build+#32; + IF ((i+1) MOD 16)=0 THEN BEGIN + string_build:=string_build+#32+ascii_version+CrLf; + ascii_version:=''; + END; + END; + END; + Result:=string_build; + END; + + +FUNCTION ExportFile(fileid:LongWord; convert:Boolean):Integer; + VAR + i:Byte; + BEGIN + Result:=export_noerror; + + //ExportDefFileHeader(fileid); + + IF (dat_files[fileid].FileType AND $02)=0 THEN BEGIN + //ExportDatFile(fileid); + + FOR i:=1 TO Length(ExportHandlers)+1 DO BEGIN + IF i<=Length(ExportHandlers) THEN BEGIN + IF ExportHandlers[i].Ext=dat_files[fileid].Extension THEN BEGIN + IF ExportHandlers[i].needed THEN BEGIN + CASE ExportHandlers[i].Handler(fileid,convert) OF + 0: Result:=0; + ELSE + Result:=export_handlererror; + END; + END; + Break; + END; + END ELSE BEGIN + Result:=export_nohandler; + END; + END; + END; + END; + + +FUNCTION GetWinFileName(fileid:LongWord; substring:String):String; + VAR + name:String; + BEGIN + name:=dat_files[fileid].Name; + name:=AnsiReplaceStr(name,'\','__'); + name:=AnsiReplaceStr(name,'/','__'); + name:=AnsiReplaceStr(name,'>','__'); + name:=AnsiReplaceStr(name,'<','__'); + Result:=FormatNumber(fileid,5,'0')+'-'+name+'.'+substring+'.'+dat_files[fileid].Extension; + END; + +FUNCTION GetExtractPath:String; + BEGIN + Result:=ExtractFilePath(dat_filename)+'\extracted_'+ExtractFileName(dat_filename); + END; + + +END. Index: /oup/releases/0.18a2/Unit3_data.pas =================================================================== --- /oup/releases/0.18a2/Unit3_data.pas (revision 21) +++ /oup/releases/0.18a2/Unit3_data.pas (revision 21) @@ -0,0 +1,85 @@ +UNIT Unit3_data; +INTERFACE +USES Classes; + +CONST + version:String='v0.18.2a'; + CrLf:String[2]=#13+#10; + +TYPE + Tdata=Array OF Byte; + Theader=PACKED RECORD + Ident:Array[0..$13] OF Byte; + Files:LongWord; + NamedFiles:LongWord; + Extensions:LongWord; + DataAddr:LongWord; + DataSize:LongWord; + NamesAddr:LongWord; + NamesSize:LongWord; + Ident2:Array[0..$F] OF Byte; + END; + Tfilesmap=Array OF PACKED RECORD + Extension:Array[0..$3] OF Char; + DataAddr:LongWord; + NameAddr:LongWord; + FileSize:LongWord; + FileType:LongWord; + END; + Tfiles=Array OF PACKED RECORD + FileName:String; + Extension:String[4]; + Name:String; + Size:LongWord; + FileType:LongWord; + DatAddr:LongWord; + opened:Boolean; + END; + + Tnamedfilesmap=Array OF PACKED RECORD + FileNumber:LongWord; + blubb:LongWord; + END; + Textensionsmap=Array OF PACKED RECORD + Ident:Array[0..$7] OF Byte; + Extension:Array[0..$3] OF Char; + ExtCount:LongWord; + END; + + TAppSettings=RECORD + DatPath:String[250]; + ExtractPath:String[250]; + END; + + TExportHandlers=RECORD + Ext:String[4]; + needed:Boolean; + Handler:Function(fileid:LongWord; convert:Boolean):Integer; + END; + +VAR + dat_filename:String=''; + raw_filename:String=''; + dat_header:Theader; + dat_filesmap:Tfilesmap; + dat_files:Tfiles; + dat_namedfilesmap:Tnamedfilesmap; + dat_extensionsmap:Textensionsmap; + AppSettings:TAppSettings; + AppSettingsFile:File OF TAppSettings; + +CONST + header_ident1:Array[0..$13] OF Byte= + ($1F,$27,$DC,$33,$DF,$BC,$03,$00,$31,$33,$52,$56,$40,$00,$14,$00,$10,$00,$08,$00); + header_ident2:Array[0..$F] OF Byte= + ($99,$CF,$40,$00,$90,$4F,$63,$00,$F4,$55,$5F,$00,$90,$4F,$63,$00); + + export_noerror:Integer=0; + export_nohandler:Integer=1; + export_handlererror:Integer=2; + export_error:Integer=3; + +IMPLEMENTATION + +END. + Index: /oup/releases/0.18a2/Unit4_Exporters.pas =================================================================== --- /oup/releases/0.18a2/Unit4_Exporters.pas (revision 21) +++ /oup/releases/0.18a2/Unit4_Exporters.pas (revision 21) @@ -0,0 +1,181 @@ +UNIT Unit4_Exporters; +INTERFACE +USES Classes, StrUtils, SysUtils, Math, Unit3_data, Unit6_imgfuncs; + +PROCEDURE ExportDefLine(fileid:LongWord; line:String; create:Boolean); +PROCEDURE ExportDefFileHeader(fileid:LongWord); +PROCEDURE ExportDatFile(fileid:LongWord; filename:String); + +FUNCTION ExportTRAC(fileid:LongWord; convert:Boolean):Integer; +FUNCTION ExportTXAN(fileid:LongWord; convert:Boolean):Integer; +FUNCTION ExportTXMB(fileid:LongWord; convert:Boolean):Integer; +FUNCTION ExportTXMP(fileid:LongWord; convert:Boolean):Integer; +VAR + ExportHandlers:Array[1..5] OF TExportHandlers=( + (Ext:'ABNA'; needed:False), + //(Ext:'AGDB'; needed:False), + (Ext:'TRAC'; needed:True; Handler:ExportTRAC), + (Ext:'TXAN'; needed:True; Handler:ExportTXAN), + (Ext:'TXMB'; needed:True; Handler:ExportTXMB), + (Ext:'TXMP'; needed:True; Handler:ExportTXMP) + ); + + + +IMPLEMENTATION +USES Unit2_functions; + +PROCEDURE ExportDefLine(fileid:LongWord; line:String; create:Boolean); + VAR + filestream:TFileStream; + data:Tdata; + i:LongWord; + BEGIN + SetLength(data,Length(line)+2); + FOR i:=1 TO Length(line) DO + data[i-1]:=Ord(line[i]); + data[Length(line)]:=13; + data[Length(line)+1]:=10; + { + IF create THEN + filestream:=TFileStream.Create(GetExtractPath+'\'+GetWinFileName(fileid,'_DEF_'),fmCreate) + ELSE BEGIN + filestream:=TFileStream.Create(GetExtractPath+'\'+GetWinFileName(fileid,'_DEF_'),fmOpenWrite); + filestream.Seek(0,soFromEnd); + END; + filestream.Write(data[0],Length(data)); + filestream.Free; + } + END; + +PROCEDURE ExportDefFileHeader(fileid:LongWord); + BEGIN + IF NOT DirectoryExists(GetExtractPath) THEN + CreateDir(GetExtractPath); + WITH dat_files[fileid] DO + ExportDefLine(fileid,FormatNumber(fileid,5,'0')+':'+Name+':'+Extension+':'+IntToHex(Size,8)+':'+IntToHex(FileType,8),True); + END; + +PROCEDURE ExportDatFile(fileid:LongWord; filename:String); + VAR + filestream:TFileStream; + data:Tdata; + BEGIN + data:=LoadDatFile(fileid); + filestream:=TFileStream.Create(filename,fmCreate); + filestream.Write(data[0],Length(data)); + filestream.Free; + END; + + +FUNCTION ExportTRAC; + VAR + link:LongWord; + linkcount:Word; + i:LongWord; + BEGIN + Result:=export_noerror; + + LoadDatFilePart(fileid,$18,SizeOf(link),@link); + link:=link DIV 256; + ExportDefLine(fileid,FormatNumber(0,4,'0')+':LINKtoTRAC:'+FormatNumber(link,5,'0')+':'+dat_files[link].Name+':'+dat_files[link].Extension,False); + + LoadDatFilePart(fileid,$1E,SizeOf(linkcount),@linkcount); + ExportDefLine(fileid,'TRAMLINKS:'+FormatNumber(linkcount,4,'0'),False); + FOR i:=1 TO linkcount DO BEGIN + LoadDatFilePart(fileid,$20+(i-1)*12+8,SizeOf(link),@link); + link:=link DIV 256; + ExportDefLine(fileid,FormatNumber(i,4,'0')+':LINKtoTRAM:'+FormatNumber(link,5,'0')+':'+dat_files[link].Name+':'+dat_files[link].Extension,False); + END; + END; + +FUNCTION ExportTXAN; + VAR + loop_speed,unknown:Word; + linkcount:LongWord; + link:LongWord; + i:Byte; + BEGIN + Result:=export_noerror; + + LoadDatFilePart(fileid,$14,SizeOf(loop_speed),@loop_speed); + LoadDatFilePart(fileid,$16,SizeOf(unknown),@unknown); + ExportDefLine(fileid,'LOOPSPEED:'+FormatNumber(loop_speed,2,'0'),False); + ExportDefLine(fileid,'UNKNOWN:'+FormatNumber(unknown,2,'0'),False); + + LoadDatFilePart(fileid,$1C,SizeOf(linkcount),@linkcount); + ExportDefLine(fileid,'TXMPLINKS:'+FormatNumber(linkcount,4,'0'),False); + FOR i:=0 TO linkcount-1 DO BEGIN + LoadDatFilePart(fileid,$20+i*4,SizeOf(link),@link); + link:=link DIV 256; + IF link=0 THEN link:=fileid-1; + ExportDefLine(fileid,FormatNumber(i,4,'0')+':LINKtoTXMP:'+FormatNumber(link,5,'0')+':'+dat_files[link].Name+':'+dat_files[link].Extension,False); + END; + END; + +FUNCTION ExportTXMB; + VAR + filestream:TFileStream; + subfile:Byte; + linkcount:LongWord; + link:LongWord; + width,height:Word; + cols,rows:Word; + i:Byte; + img:TImgPackage; + data:Tdata; + BEGIN + Result:=export_noerror; + subfile:=1; + + LoadDatFilePart(fileid,$10,SizeOf(width),@width); + LoadDatFilePart(fileid,$12,SizeOf(height),@height); + LoadDatFilePart(fileid,$18,SizeOf(cols),@cols); + LoadDatFilePart(fileid,$1A,SizeOf(rows),@rows); + ExportDefLine(fileid,'WIDTH:'+FormatNumber(width,4,'0'),False); + ExportDefLine(fileid,'HEIGHT:'+FormatNumber(height,4,'0'),False); + ExportDefLine(fileid,'COLS:'+FormatNumber(cols,2,'0'),False); + ExportDefLine(fileid,'ROWS:'+FormatNumber(rows,2,'0'),False); + + LoadDatFilePart(fileid,$1C,SizeOf(linkcount),@linkcount); + ExportDefLine(fileid,'TXMPLINKS:'+FormatNumber(linkcount,4,'0'),False); + FOR i:=0 TO linkcount-1 DO BEGIN + LoadDatFilePart(fileid,$20+i*4,SizeOf(link),@link); + link:=link DIV 256; + IF link=0 THEN link:=fileid-1; + ExportDefLine(fileid,FormatNumber(i,4,'0')+':LINKtoTXMP:'+FormatNumber(link,5,'0')+':'+dat_files[link].Name+':'+dat_files[link].Extension,False); + END; + + IF convert THEN BEGIN + img:=LoadTXMBconnected(fileid); + data:=ImgdataToBmp(img.imgx,img.imgy,img.imgdepth,img.storetype,img.imgdata); + filestream:=TFileStream.Create(GetExtractPath+'\'+GetWinFileName(fileid,FormatNumber(subfile,2,'0')+'-ImgData')+'.bmp',fmCreate); + filestream.Write(data[0],Length(data)); + filestream.Free; + END; + END; + +FUNCTION ExportTXMP; + VAR + filestream:TFileStream; + subfile:Byte; + img:TImgPackage; + BEGIN + Result:=export_noerror; + subfile:=1; + + img:=LoadImgData(fileid); + { + filestream:=TFileStream.Create(GetExtractPath+'\'+GetWinFileName(fileid,FormatNumber(subfile,2,'0')+'-ImgData'),fmCreate); + filestream.Write(img.imgdata[0],Length(img.imgdata)); + filestream.Free; + } + IF convert THEN BEGIN + img.imgdata:=ImgdataToBMP(img.imgx,img.imgy,img.imgdepth,img.storetype,img.imgdata); + filestream:=TFileStream.Create(GetExtractPath+'\'+GetWinFileName(fileid,FormatNumber(subfile,2,'0')+'-ImgData')+'.bmp',fmCreate); + filestream.Write(img.imgdata[0],Length(img.imgdata)); + filestream.Free; + END; + END; + +END. Index: /oup/releases/0.18a2/Unit5_preview.dfm =================================================================== --- /oup/releases/0.18a2/Unit5_preview.dfm (revision 21) +++ /oup/releases/0.18a2/Unit5_preview.dfm (revision 21) @@ -0,0 +1,156 @@ +object Form5: TForm5 + Left = 0 + Top = 0 + Width = 300 + Height = 200 + Caption = 'Preview' + Color = clBtnFace + Font.Charset = DEFAULT_CHARSET + Font.Color = clWindowText + Font.Height = -11 + Font.Name = 'Tahoma' + Font.Style = [] + FormStyle = fsMDIChild + OldCreateOrder = False + Visible = True + OnActivate = FormActivate + OnClose = FormClose + OnCreate = FormCreate + OnResize = FormResize + PixelsPerInch = 96 + TextHeight = 13 + object Splitter1: TSplitter + Left = 150 + Top = 0 + Width = 9 + Height = 173 + AutoSnap = False + Beveled = True + MinSize = 150 + end + object panel_preview: TPanel + Left = 159 + Top = 0 + Width = 133 + Height = 173 + Align = alClient + BevelOuter = bvNone + TabOrder = 0 + object img: TImage + Left = 0 + Top = 20 + Width = 133 + Height = 153 + Align = alClient + end + object lbl_notpossible: TLabel + Left = 16 + Top = 56 + Width = 97 + Height = 65 + AutoSize = False + Caption = 'No preview possible for this filetype' + Font.Charset = DEFAULT_CHARSET + Font.Color = clWindowText + Font.Height = -16 + Font.Name = 'Tahoma' + Font.Style = [] + ParentFont = False + Visible = False + WordWrap = True + end + object panel_buttons: TPanel + Left = 0 + Top = 0 + Width = 133 + Height = 20 + Align = alTop + BevelOuter = bvNone + TabOrder = 0 + Visible = False + OnResize = panel_buttonsResize + object btn_dec: TButton + Left = 0 + Top = 0 + Width = 20 + Height = 20 + Caption = '-' + Enabled = False + TabOrder = 0 + OnClick = btn_decClick + end + object btn_startstop: TButton + Left = 21 + Top = 0 + Width = 80 + Height = 20 + Caption = 'Stop automatic' + TabOrder = 1 + OnClick = btn_startstopClick + end + object btn_inc: TButton + Left = 102 + Top = 0 + Width = 20 + Height = 20 + Caption = '+' + Enabled = False + TabOrder = 2 + OnClick = btn_incClick + end + end + end + object panel_files: TPanel + Left = 0 + Top = 0 + Width = 150 + Height = 173 + Align = alLeft + BevelOuter = bvNone + TabOrder = 1 + object list: TListBox + Left = 0 + Top = 0 + Width = 150 + Height = 148 + Align = alClient + ItemHeight = 13 + TabOrder = 0 + OnClick = listClick + end + object panel_extension: TPanel + Left = 0 + Top = 148 + Width = 150 + Height = 25 + Align = alBottom + BevelOuter = bvNone + TabOrder = 1 + OnResize = panel_extensionResize + object combo_extension: TComboBox + Left = 2 + Top = 2 + Width = 145 + Height = 21 + Style = csDropDownList + DropDownCount = 12 + Font.Charset = DEFAULT_CHARSET + Font.Color = clWindowText + Font.Height = -11 + Font.Name = 'Tahoma' + Font.Style = [] + ItemHeight = 13 + ParentFont = False + Sorted = True + TabOrder = 0 + OnClick = combo_extensionClick + end + end + end + object timer: TTimer + Enabled = False + OnTimer = timerTimer + Left = 144 + Top = 24 + end +end Index: /oup/releases/0.18a2/Unit5_preview.pas =================================================================== --- /oup/releases/0.18a2/Unit5_preview.pas (revision 21) +++ /oup/releases/0.18a2/Unit5_preview.pas (revision 21) @@ -0,0 +1,259 @@ +UNIT Unit5_preview; +INTERFACE +USES + Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, + Dialogs, Math, ExtCtrls, Unit2_functions, Unit3_data, Unit4_exporters, Unit6_imgfuncs, + StdCtrls, StrUtils; + +TYPE + TForm5 = Class(TForm) + timer: TTimer; + panel_preview: TPanel; + img: TImage; + panel_buttons: TPanel; + btn_dec: TButton; + btn_startstop: TButton; + btn_inc: TButton; + panel_files: TPanel; + list: TListBox; + panel_extension: TPanel; + combo_extension: TComboBox; + Splitter1: TSplitter; + lbl_notpossible: TLabel; + procedure FormActivate(Sender: TObject); + PROCEDURE Recreatelist; + PROCEDURE listClick(Sender: TObject); + PROCEDURE PreviewTXAN; + PROCEDURE PreviewTXMB; + PROCEDURE PreviewTXMP; + PROCEDURE panel_extensionResize(Sender: TObject); + PROCEDURE combo_extensionClick(Sender: TObject); + PROCEDURE btn_incClick(Sender: TObject); + PROCEDURE btn_decClick(Sender: TObject); + PROCEDURE FormResize(Sender: TObject); + PROCEDURE btn_startstopClick(Sender: TObject); + PROCEDURE panel_buttonsResize(Sender: TObject); + PROCEDURE timerTimer(Sender: TObject); + PROCEDURE FormCreate(Sender: TObject); + PROCEDURE FormClose(Sender: TObject; var Action: TCloseAction); + PRIVATE + PUBLIC + END; + +VAR + Form5: TForm5; + +IMPLEMENTATION +{$R *.dfm} +USES Unit1_main; +VAR + memstreams:Array OF TMemoryStream; + actualimg:Byte; + _fileid:LongWord; + + +PROCEDURE TForm5.Recreatelist; + VAR + i:LongWord; + BEGIN + combo_extension.Items.Clear; + combo_extension.Items.Add('_All files_ ('+IntToStr(dat_header.Files)+')'); + FOR i:=0 TO dat_header.Extensions-1 DO BEGIN + WITH dat_extensionsmap[i] DO BEGIN + combo_extension.Items.Add( + Extension[3]+Extension[2]+Extension[1]+Extension[0]+' ('+ + IntToStr(ExtCount)+')'); + END; + END; + combo_extension.ItemIndex:=0; + combo_extensionClick(Self); + END; + + +PROCEDURE TForm5.listClick(Sender: TObject); + BEGIN + _fileid:=StrToInt(MidStr(list.Items.Strings[list.ItemIndex],1,5)); + lbl_notpossible.Visible:=False; + Self.img.Visible:=True; + Self.timer.Enabled:=False; + Self.panel_buttons.Visible:=False; + Self.Caption:='Preview '+dat_files[_fileid].FileName; + IF dat_files[_fileid].Extension='TXAN' THEN PreviewTXAN + ELSE + IF dat_files[_fileid].Extension='TXMB' THEN PreviewTXMB + ELSE + IF dat_files[_fileid].Extension='TXMP' THEN PreviewTXMP + ELSE BEGIN + Self.lbl_notpossible.Visible:=True; + Self.img.Visible:=False; + END; + END; + + +PROCEDURE TForm5.panel_extensionResize(Sender: TObject); + BEGIN + combo_extension.Width:=panel_extension.Width-5; + END; + + +PROCEDURE TForm5.combo_extensionClick(Sender: TObject); + VAR + Extension:String[4]; + i:LongWord; + BEGIN + Extension:=MidStr(combo_extension.Items.Strings[combo_extension.ItemIndex],1,4); + list.Items.Clear; + IF Extension='_All' THEN BEGIN + FOR i:=0 TO dat_header.Files-1 DO + IF (dat_files[i].FileType AND $02)=0 THEN + list.Items.Add(dat_files[i].FileName); + END ELSE BEGIN + FOR i:=0 TO dat_header.Files-1 DO + IF dat_files[i].Extension=Extension THEN + IF (dat_files[i].FileType AND $02)=0 THEN + list.Items.Add(dat_files[i].FileName); + END; + END; + + +PROCEDURE TForm5.PreviewTXMB; + VAR + data:Tdata; + img:TImgPackage; + BEGIN + SetLength(memstreams,1); + img:=LoadTXMBconnected(_fileid); + data:=ImgdataToBmp(img.imgx,img.imgy,img.imgdepth,img.storetype,img.imgdata); + + memstreams[0].Clear; + memstreams[0].Write(data[0],Length(data)); + memstreams[0].Seek(0,soFromBeginning); + + Self.img.Picture.Bitmap.LoadFromStream(memstreams[0]); + END; + +PROCEDURE TForm5.PreviewTXMP; + VAR + data:Tdata; + img:TImgPackage; + BEGIN + SetLength(memstreams,1); + img:=LoadImgData(_fileid); + data:=ImgdataToBmp(img.imgx,img.imgy,img.imgdepth,img.storetype,img.imgdata); + + memstreams[0].Clear; + memstreams[0].Write(data[0],Length(data)); + memstreams[0].Seek(0,soFromBeginning); + + Self.img.Picture.Bitmap.LoadFromStream(memstreams[0]); + END; + +PROCEDURE TForm5.PreviewTXAN; + VAR + loop_speed:Word; + linkcount:LongWord; + link:LongWord; + i:Byte; + data:Tdata; + img:TImgPackage; + BEGIN + LoadDatFilePart(_fileid,$14,SizeOf(loop_speed),@loop_speed); + LoadDatFilePart(_fileid,$1C,SizeOf(linkcount),@linkcount); + SetLength(memstreams,linkcount); + FOR i:=0 TO linkcount-1 DO BEGIN + LoadDatFilePart(_fileid,$20+i*4,SizeOf(link),@link); + link:=link DIV 256; + IF link=0 THEN link:=_fileid-1; + memstreams[i]:=TMemoryStream.Create; + img:=LoadImgData(link); + data:=ImgdataToBmp(img.imgx,img.imgy,img.imgdepth,img.storetype,img.imgdata); + memstreams[i].Clear; + memstreams[i].Write(data[0],Length(data)); + memstreams[i].Seek(0,soFromBeginning); + END; + actualimg:=254; + Self.timer.Interval:=Floor(loop_speed*(1/60)*1000); + Self.timer.Enabled:=False; + Self.btn_startstopClick(Self); + Self.panel_buttons.Visible:=True; + END; + + +PROCEDURE TForm5.FormCreate(Sender: TObject); + BEGIN + SetLength(memstreams,1); + memstreams[0]:=TMemoryStream.Create; + Self.Width:=260; + Self.Height:=300; + END; + +PROCEDURE TForm5.timerTimer(Sender: TObject); + BEGIN + Inc(actualimg); + IF actualimg>=Length(memstreams) THEN actualimg:=0; + Self.img.Picture.Bitmap.LoadFromStream(memstreams[actualimg]); + memstreams[actualimg].Seek(0,soFromBeginning); + Self.Caption:='Preview '+dat_files[_fileid].FileName+' ('+IntToStr(actualimg+1)+'/'+IntToStr(Length(memstreams))+')'; + END; + +PROCEDURE TForm5.panel_buttonsResize(Sender: TObject); + BEGIN + btn_startstop.Width:=panel_buttons.Width-45; + btn_inc.Left:=panel_buttons.Width-23; + END; + +PROCEDURE TForm5.btn_startstopClick(Sender: TObject); + BEGIN + Self.timer.Enabled:=NOT Self.timer.Enabled; + Self.btn_dec.Enabled:=NOT Self.timer.Enabled; + Self.btn_inc.Enabled:=NOT Self.timer.Enabled; + IF Self.timer.Enabled THEN + Self.btn_startstop.Caption:='Stop automatic' + ELSE + Self.btn_startstop.Caption:='Start automatic'; + END; + +PROCEDURE TForm5.FormResize(Sender: TObject); + BEGIN + IF Self.Width>=300 THEN BEGIN + END ELSE Self.Width:=300; + IF Self.Height>=200 THEN BEGIN + END ELSE Self.Height:=200; + END; + +PROCEDURE TForm5.btn_decClick(Sender: TObject); + BEGIN + IF actualimg>0 THEN + Dec(actualimg) + ELSE + actualimg:=High(memstreams); + Self.Caption:='Preview '+dat_files[_fileid].FileName+' ('+IntToStr(actualimg+1)+'/'+IntToStr(Length(memstreams))+')'; + Self.img.Picture.Bitmap.LoadFromStream(memstreams[actualimg]); + memstreams[actualimg].Seek(0,soFromBeginning); + END; + +PROCEDURE TForm5.btn_incClick(Sender: TObject); + BEGIN + IF actualimg0) THEN BEGIN + Inc(row_orig); + IF (row_orig MOD 2)=0 THEN BEGIN + Inc(row); + col:=0; + END; + END; + IF (row_orig MOD 2)=0 THEN BEGIN + IF (i MOD 2)=0 THEN BEGIN + FOR j:=0 TO (imgdepth DIV 8)-1 DO + temparray[((row*(oldx DIV 2))+col)*(imgdepth DIV 8)+j]:=data[i*2+j]; + Inc(col); + END; + END; + END; + Result:=temparray; + END; + + +FUNCTION RevertImage(imgx,imgy,imgdepth:LongWord; imgdata:Tdata):Tdata; + VAR + x,y,i:LongWord; + BEGIN + SetLength(Result,imgx*imgy*(imgdepth DIV 8)); + FOR y:=0 TO imgy-1 DO + FOR x:=0 TO imgx-1 DO + FOR i:=0 TO (imgdepth DIV 8)-1 DO + Result[((imgx*(imgy-1-y)+x)*(imgdepth DIV 8))+i]:= + imgdata[(imgx*y+x)*(imgdepth DIV 8)+i]; + END; + + +FUNCTION DecompressImage(imgx,imgy:LongWord; imgdata:Tdata):Tdata; + TYPE + Tcolor=RECORD + RGBb:Byte; + RGBg:Byte; + RGBr:Byte; + RGBa:Byte; + END; + VAR + i,j,x,y:LongWord; + color:Array[1..4] OF Tcolor; + pixel:Array[1..16] OF Byte; + BEGIN + x:=0; + y:=0; + SetLength(Result,imgx*imgy*4); + FOR i:=0 TO ((imgx*imgy) DIV 16)-1 DO BEGIN + Color[1].RGBb:=Floor(((imgdata[(i*8)+0]+imgdata[(i*8)+1]*256) AND $001F) / $001F * 255); + Color[1].RGBg:=Floor(((imgdata[(i*8)+0]+imgdata[(i*8)+1]*256) AND $07E0) / $07E0 * 255); + Color[1].RGBr:=Floor(((imgdata[(i*8)+0]+imgdata[(i*8)+1]*256) AND $F800) / $F800 * 255); + Color[1].RGBa:=255; + Color[2].RGBb:=Floor(((imgdata[(i*8)+2]+imgdata[(i*8)+3]*256) AND $001F) / $001F * 255); + Color[2].RGBg:=Floor(((imgdata[(i*8)+2]+imgdata[(i*8)+3]*256) AND $07E0) / $07E0 * 255); + Color[2].RGBr:=Floor(((imgdata[(i*8)+2]+imgdata[(i*8)+3]*256) AND $F800) / $F800 * 255); + Color[2].RGBa:=255; + Color[3].RGBb:=Floor( Color[1].RGBb/3*2 + Color[2].RGBb/3 ); + Color[3].RGBg:=Floor( Color[1].RGBg/3*2 + Color[2].RGBg/3 ); + Color[3].RGBr:=Floor( Color[1].RGBr/3*2 + Color[2].RGBr/3 ); + Color[3].RGBa:=255; + Color[4].RGBb:=Floor( Color[1].RGBb/3 + Color[2].RGBb/3*2 ); + Color[4].RGBg:=Floor( Color[1].RGBg/3 + Color[2].RGBg/3*2 ); + Color[4].RGBr:=Floor( Color[1].RGBr/3 + Color[2].RGBr/3*2 ); + Color[4].RGBa:=255; + Pixel[1]:=Floor( (imgdata[(i*8)+4] AND $C0) / $40 + 1 ); + Pixel[2]:=Floor( (imgdata[(i*8)+4] AND $30) / $10 + 1 ); + Pixel[3]:=Floor( (imgdata[(i*8)+4] AND $0C) / $04 + 1 ); + Pixel[4]:=Floor( (imgdata[(i*8)+4] AND $03) + 1 ); + Pixel[5]:=Floor( (imgdata[(i*8)+5] AND $C0) / $40 + 1 ); + Pixel[6]:=Floor( (imgdata[(i*8)+5] AND $30) / $10 + 1 ); + Pixel[7]:=Floor( (imgdata[(i*8)+5] AND $0C) / $04 + 1 ); + Pixel[8]:=Floor( (imgdata[(i*8)+5] AND $03) + 1 ); + Pixel[9]:=Floor( (imgdata[(i*8)+6] AND $C0) / $40 + 1 ); + Pixel[10]:=Floor( (imgdata[(i*8)+6] AND $30) / $10 + 1 ); + Pixel[11]:=Floor( (imgdata[(i*8)+6] AND $0C) / $04 + 1 ); + Pixel[12]:=Floor( (imgdata[(i*8)+6] AND $03) + 1 ); + Pixel[13]:=Floor( (imgdata[(i*8)+7] AND $C0) / $40 + 1 ); + Pixel[14]:=Floor( (imgdata[(i*8)+7] AND $30) / $10 + 1 ); + Pixel[15]:=Floor( (imgdata[(i*8)+7] AND $0C) / $04 + 1 ); + Pixel[16]:=Floor( (imgdata[(i*8)+7] AND $03) + 1 ); + FOR j:=0 TO 3 DO BEGIN + Result[((y+3)*imgx+x+j)*3+0]:=Color[Pixel[16-j]].RGBb; + Result[((y+3)*imgx+x+j)*3+1]:=Color[Pixel[16-j]].RGBg; + Result[((y+3)*imgx+x+j)*3+2]:=Color[Pixel[16-j]].RGBr; + END; + FOR j:=0 TO 3 DO BEGIN + Result[((y+2)*imgx+x+j)*3+0]:=Color[Pixel[12-j]].RGBb; + Result[((y+2)*imgx+x+j)*3+1]:=Color[Pixel[12-j]].RGBg; + Result[((y+2)*imgx+x+j)*3+2]:=Color[Pixel[12-j]].RGBr; + END; + FOR j:=0 TO 3 DO BEGIN + Result[((y+1)*imgx+x+j)*3+0]:=Color[Pixel[8-j]].RGBb; + Result[((y+1)*imgx+x+j)*3+1]:=Color[Pixel[8-j]].RGBg; + Result[((y+1)*imgx+x+j)*3+2]:=Color[Pixel[8-j]].RGBr; + END; + FOR j:=0 TO 3 DO BEGIN + Result[((y+0)*imgx+x+j)*3+0]:=Color[Pixel[4-j]].RGBb; + Result[((y+0)*imgx+x+j)*3+1]:=Color[Pixel[4-j]].RGBg; + Result[((y+0)*imgx+x+j)*3+2]:=Color[Pixel[4-j]].RGBr; + END; + x:=x+4; + IF x=imgx THEN BEGIN + y:=y+4; + x:=0; + END; + END; + END; + + +FUNCTION ImgdataToBmp(imgx,imgy,imgdepth,storetype:LongWord; imgdata:Tdata):Tdata; + CONST BMPheader:Array[0..53] OF Byte= + ($42,$4D,0,0,0,0,0,0,0,0,54,0,0,0, + 40,0,0,0,0,0,0,0,0,0,0,0,1,0,$18,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0); + VAR + i,x,y:LongWord; + BEGIN + CASE storetype OF + 0: BEGIN + SetLength(Result,imgx*imgy*3); + FOR y:=0 TO imgy-1 DO BEGIN + FOR x:=0 TO imgx-1 DO BEGIN + Result[((imgx*y+x)*3)+0]:=Floor( ( (imgdata[(imgx*y+x)*2]+imgdata[(imgx*y+x)*2+1]*256) AND $000F ) / $000F * 255); + Result[((imgx*y+x)*3)+1]:=Floor( ( (imgdata[(imgx*y+x)*2]+imgdata[(imgx*y+x)*2+1]*256) AND $00F0 ) / $00F0 * 255); + Result[((imgx*y+x)*3)+2]:=Floor( ( (imgdata[(imgx*y+x)*2]+imgdata[(imgx*y+x)*2+1]*256) AND $0F00 ) / $0F00 * 255); + END; + END; + END; + 1,2: BEGIN + SetLength(Result,imgx*imgy*3); + FOR y:=0 TO imgy-1 DO BEGIN + FOR x:=0 TO imgx-1 DO BEGIN + Result[((imgx*y+x)*3)+0]:=Floor( ( (imgdata[(imgx*y+x)*2]+imgdata[(imgx*y+x)*2+1]*256) AND $001F ) / $001F * 255); + Result[((imgx*y+x)*3)+1]:=Floor( ( (imgdata[(imgx*y+x)*2]+imgdata[(imgx*y+x)*2+1]*256) AND $03E0 ) / $03E0 * 255); + Result[((imgx*y+x)*3)+2]:=Floor( ( (imgdata[(imgx*y+x)*2]+imgdata[(imgx*y+x)*2+1]*256) AND $7C00 ) / $7C00 * 255); + END; + END; + END; + 8: BEGIN + SetLength(Result,imgx*imgy*3); + FOR y:=0 TO imgy-1 DO BEGIN + FOR x:=0 TO imgx-1 DO BEGIN + Result[((imgx*y+x)*3)+0]:=imgdata[(imgx*y+x)*4+0]; + Result[((imgx*y+x)*3)+1]:=imgdata[(imgx*y+x)*4+1]; + Result[((imgx*y+x)*3)+2]:=imgdata[(imgx*y+x)*4+2]; + END; + END; + END; + 9: BEGIN + Result:=DecompressImage(imgx,imgy,imgdata); + END; + END; + Result:=RevertImage(imgx,imgy,24,Result); + SetLength(Result,imgx*imgy*3+54); + FOR i:=High(Result)-54 DOWNTO 0 DO Result[i+54]:=Result[i]; + + FOR i:=0 TO High(BMPheader) DO Result[i]:=BMPheader[i]; + Result[2]:=((imgx*imgy*3+54) AND $000000FF); + Result[3]:=((imgx*imgy*3+54) AND $0000FF00) DIV $100; + Result[4]:=((imgx*imgy*3+54) AND $00FF0000) DIV $10000; + Result[5]:=((imgx*imgy*3+54) AND $FF000000) DIV $1000000; + Result[18]:=(imgx AND $000000FF) DIV $1; + Result[19]:=(imgx AND $0000FF00) DIV $100; + Result[20]:=(imgx AND $00FF0000) DIV $10000; + Result[21]:=(imgx AND $FF000000) DIV $1000000; + Result[22]:=(imgy AND $000000FF) DIV $1; + Result[23]:=(imgy AND $0000FF00) DIV $100; + Result[24]:=(imgy AND $00FF0000) DIV $10000; + Result[25]:=(imgy AND $FF000000) DIV $1000000; + Result[34]:=((imgx*imgy*3) AND $000000FF) DIV $1; + Result[35]:=((imgx*imgy*3) AND $0000FF00) DIV $100; + Result[36]:=((imgx*imgy*3) AND $00FF0000) DIV $10000; + Result[37]:=((imgx*imgy*3) AND $FF000000) DIV $1000000; + END; + +FUNCTION BmpToImgdata(bmpdata:Tdata; _32bit:Boolean):TImgPackage; + VAR + x,y:LongWord; + r24,g24,b24:Word; + r16,g16,b16:Word; + gesamt:Word; + BEGIN + Result.imgdepth:=0; + IF NOT((bmpdata[00]=$42) AND (bmpdata[01]=$4D)) THEN BEGIN + ShowMessage('Not a standard 24bit bitmap'); + Exit; + END; + IF NOT(bmpdata[10]=54) THEN BEGIN + ShowMessage('Imagedata has to start at 0x54'); + Exit; + END; + IF NOT(bmpdata[14]=40) THEN BEGIN + ShowMessage('Second bitmap header has to have 40 bytes'); + Exit; + END; + IF NOT(bmpdata[28]=24) THEN BEGIN + ShowMessage('Bitmap has to have 24bits'); + Exit; + END; + IF NOT(bmpdata[30]=0) THEN BEGIN + ShowMessage('Bitmap has to be uncompressed'); + Exit; + END; + Result.imgx:=bmpdata[18]+bmpdata[19]*256+bmpdata[20]*256*256+bmpdata[21]*256*256*256; + Result.imgy:=bmpdata[22]+bmpdata[23]*256+bmpdata[24]*256*256+bmpdata[25]*256*256*256; + IF _32bit THEN BEGIN + Result.imgdepth:=32; + Result.storetype:=8; + END ELSE BEGIN + Result.imgdepth:=16; + Result.storetype:=1; + END; + + SetLength(Result.imgdata,Result.imgx*Result.imgy*Result.imgdepth DIV 8); + IF _32bit THEN BEGIN + FOR y:=0 TO Result.imgy-1 DO BEGIN + FOR x:=0 TO Result.imgx-1 DO BEGIN + Result.imgdata[((Result.imgx*y+x)*4)+0]:=bmpdata[54+(Result.imgx*y+x)*3+0]; + Result.imgdata[((Result.imgx*y+x)*4)+1]:=bmpdata[54+(Result.imgx*y+x)*3+1]; + Result.imgdata[((Result.imgx*y+x)*4)+2]:=bmpdata[54+(Result.imgx*y+x)*3+2]; + Result.imgdata[((Result.imgx*y+x)*4)+3]:=0; + END; + END; + END ELSE BEGIN + FOR y:=0 TO Result.imgy-1 DO BEGIN + FOR x:=0 TO Result.imgx-1 DO BEGIN + r24:=bmpdata[54+(Result.imgx*y+x)*3+0]; + g24:=bmpdata[54+(Result.imgx*y+x)*3+1]; + b24:=bmpdata[54+(Result.imgx*y+x)*3+2]; + r16:=(Ceil(r24*$001F/255)) AND $001F; + g16:=(Ceil(g24*$03E0/255)) AND $03E0; + b16:=(Ceil(b24*$7C00/255)) AND $7C00; + gesamt:=r16+g16+b16; + Result.imgdata[((Result.imgx*y+x)*2)+0]:=gesamt AND $00FF; + Result.imgdata[((Result.imgx*y+x)*2)+1]:=(gesamt AND $FF00) DIV 256; + END; + END; + END; + + Result.imgdata:=RevertImage(Result.imgx,Result.imgy,Result.imgdepth,Result.imgdata); + END; + +FUNCTION LoadTXMBconnected(fileid:LongWord):TImgPackage; + VAR + i,x,y,x2,y2,pixelid,imgid:LongWord; + rows,cols:Word; + linkcount:LongWord; + link:LongWord; + single_image:TImgPackage; + images_decoded:Array OF TImgPackage; + x_start,y_start:LongWord; + BEGIN + LoadDatFilePart(fileid,$10,SizeOf(Result.imgx),@Result.imgx); + LoadDatFilePart(fileid,$12,SizeOf(Result.imgy),@Result.imgy); + LoadDatFilePart(fileid,$18,SizeOf(cols),@cols); + LoadDatFilePart(fileid,$1A,SizeOf(rows),@rows); + LoadDatFilePart(fileid,$1C,SizeOf(linkcount),@linkcount); + SetLength(images_decoded,linkcount); + FOR i:=0 TO linkcount-1 DO BEGIN + LoadDatFilePart(fileid,$20+i*4,SizeOf(link),@link); + link:=link DIV 256; + single_image:=LoadImgData(link); + images_decoded[i]:=BmpToImgdata(ImgdataToBmp(single_image.imgx,single_image.imgy,single_image.imgdepth,single_image.storetype,single_image.imgdata),False); + END; + SetLength(Result.imgdata,Result.imgx*Result.imgy*2); + FOR y:=0 TO rows-1 DO BEGIN + FOR x:=0 TO cols-1 DO BEGIN + imgid:=y*cols+x; + x_start:=0; + y_start:=0; + FOR i:=0 TO x DO IF i=400 THEN BEGIN + END ELSE Self.Width:=400; + IF Self.Height>=350 THEN BEGIN + END ELSE Self.Height:=350; + END; + +PROCEDURE TForm7.list_txmpClick(Sender: TObject); + VAR + id:LongWord; + data:Tdata; + img:TImgPackage; + mem:TMemoryStream; + fadingbyte,depthbyte,storebyte:Byte; + BEGIN + id:=StrToInt(MidStr(list_txmp.Items.Strings[list_txmp.ItemIndex],1,5)); + + LoadDatFilePart(id,$88,SizeOf(fadingbyte),@fadingbyte); + LoadDatFilePart(id,$89,SizeOf(depthbyte),@depthbyte); + LoadDatFilePart(id,$90,SizeOf(storebyte),@storebyte); + check_fading.Checked:=(fadingbyte AND $01)>0; + check_transparency.Checked:=(depthbyte AND $04)>0; + check_32bit.Checked:=(storebyte=8); + + img:=LoadImgData(id); + data:=ImgdataToBmp(img.imgx,img.imgy,img.imgdepth,img.storetype,img.imgdata); + + mem:=TMemoryStream.Create; + mem.Write(data[0],Length(data)); + mem.Seek(0,soFromBeginning); + image_txmppreview.Picture.Bitmap.LoadFromStream(mem); + mem.Free; + + group_bmpselect.Enabled:=True; + END; + +PROCEDURE TForm7.btn_loadClick(Sender: TObject); + VAR + bmpfile:TFileStream; + mem:TMemoryStream; + BEGIN + IF opend.Execute THEN BEGIN + bmpfile:=TFileStream.Create(opend.FileName, fmOpenRead); + SetLength(actual_bmpdata,bmpfile.Size); + bmpfile.Read(actual_bmpdata[0],bmpfile.Size); + bmpfile.Free; + + mem:=TMemoryStream.Create; + mem.Write(actual_bmpdata[0],Length(actual_bmpdata)); + mem.Seek(0,soFromBeginning); + image_bmppreview.Picture.Bitmap.LoadFromStream(mem); + mem.Free; + + group_options.Enabled:=True; + END; + END; + +PROCEDURE TForm7.btn_replaceClick(Sender: TObject); + VAR + id:LongWord; + imgpkg:TImgPackage; + rawfile:TFileStream; + datfile:TFileStream; + dataddr:LongWord; + old_rawaddr,new_rawaddr:LongWord; + oldwidth,oldheight:Word; + oldstore,olddepth,oldfading:Byte; + oldsize:LongWord; + newsize:LongWord; + datbyte:Word; + BEGIN + IF list_txmp.ItemIndex>=0 THEN BEGIN + imgpkg:=BmpToImgdata(actual_bmpdata,check_32bit.Checked); + datfile:=TFileStream.Create(dat_filename,fmOpenReadWrite); + + id:=StrToInt(MidStr(list_txmp.Items.Strings[list_txmp.ItemIndex],1,5)); + dataddr:=dat_files[id].dataddr; + datfile.Seek(dataddr+$8C,soFromBeginning); + datfile.Read(oldwidth,2); + datfile.Seek(dataddr+$8E,soFromBeginning); + datfile.Read(oldheight,2); + datfile.Seek(dataddr+$88,soFromBeginning); + datfile.Read(oldfading,1); + datfile.Seek(dataddr+$89,soFromBeginning); + datfile.Read(olddepth,1); + datfile.Seek(dataddr+$90,soFromBeginning); + datfile.Read(oldstore,1); + datfile.Seek(dataddr+$9C,soFromBeginning); + datfile.Read(old_rawaddr,4); + IF (oldwidth<>imgpkg.imgx) OR (oldheight<>imgpkg.imgy) THEN BEGIN + IF MessageBox(Self.Handle, + PChar('Current image and new image have different size'+CrLf+ + '(Current: '+IntToStr(oldwidth)+'x'+IntToStr(oldheight)+ + ' - New: '+IntToStr(imgpkg.imgx)+'x'+IntToStr(imgpkg.imgy)+')'+CrLf+ + 'Replace anyways?'), + PChar(list_txmp.Items.Strings[list_txmp.ItemIndex]), + MB_YESNO)=IDNO THEN Exit; + END; + + rawfile:=TFileStream.Create(raw_filename,fmOpenReadWrite); + + CASE oldstore OF + 9: oldsize:=GetImageDataSize(oldwidth,oldheight,8,(oldfading AND $01)>0); + 0,1,2: oldsize:=GetImageDataSize(oldwidth,oldheight,16,(oldfading AND $01)>0); + 8: oldsize:=GetImageDataSize(oldwidth,oldheight,32,(oldfading AND $01)>0); + ELSE + oldsize:=0; + END; + IF check_32bit.Checked THEN + newsize:=GetImageDataSize(imgpkg.imgx,imgpkg.imgy,32,check_fading.Checked) + ELSE + newsize:=GetImageDataSize(imgpkg.imgx,imgpkg.imgy,16,check_fading.Checked); + + IF newsize<=oldsize THEN + new_rawaddr:=old_rawaddr + ELSE + new_rawaddr:=rawfile.Size; + + datbyte:=$00; + IF check_fading.Checked THEN datbyte:=datbyte OR $01; + datfile.Seek(dataddr+$88,soFromBeginning); + datfile.Write(datbyte,1); + datbyte:=$10; + IF check_transparency.Checked THEN datbyte:=datbyte OR $04; + datfile.Seek(dataddr+$89,soFromBeginning); + datfile.Write(datbyte,1); + datfile.Seek(dataddr+$8C,soFromBeginning); + datfile.Write(imgpkg.imgx,2); + datfile.Seek(dataddr+$8E,soFromBeginning); + datfile.Write(imgpkg.imgy,2); + IF check_32bit.Checked THEN + datbyte:=$08 + ELSE + datbyte:=$01; + datfile.Seek(dataddr+$90,soFromBeginning); + datfile.Write(datbyte,1); + datfile.Seek(dataddr+$9C,soFromBeginning); + datfile.Write(new_rawaddr,4); + datfile.Free; + + IF check_fading.Checked THEN BEGIN + imgpkg.imgdata:=CreateFadedImage(imgpkg); + END; + + rawfile.Seek(new_rawaddr,soFromBeginning); + rawfile.Write(imgpkg.imgdata[0],Length(imgpkg.imgdata)); + rawfile.Free; + + ShowMessage('TXMP-image replaced'); + END; + END; + +PROCEDURE TForm7.FormClose(Sender: TObject; var Action: TCloseAction); + BEGIN + Action:=caFree; + Form1.close_window(Self.Name); + END; + +PROCEDURE TForm7.FormActivate(Sender: TObject); + BEGIN + Form1.SetActiveWindow(Self.Name); + END; + +END. Index: /oup/releases/0.18a2/Unit8_binedit.dfm =================================================================== --- /oup/releases/0.18a2/Unit8_binedit.dfm (revision 21) +++ /oup/releases/0.18a2/Unit8_binedit.dfm (revision 21) @@ -0,0 +1,205 @@ +object Form8: TForm8 + Left = 0 + Top = 0 + Width = 650 + Height = 450 + Caption = 'Binary .dat-Editor' + Color = clBtnFace + Font.Charset = DEFAULT_CHARSET + Font.Color = clWindowText + Font.Height = -11 + Font.Name = 'Tahoma' + Font.Style = [] + FormStyle = fsMDIChild + OldCreateOrder = False + Visible = True + OnActivate = FormActivate + OnClose = FormClose + OnCloseQuery = FormCloseQuery + OnCreate = FormCreate + OnResize = FormResize + PixelsPerInch = 96 + TextHeight = 13 + object Splitter1: TSplitter + Left = 150 + Top = 0 + Width = 9 + Height = 423 + AutoSnap = False + Beveled = True + MinSize = 150 + end + object panel_data: TPanel + Left = 159 + Top = 0 + Width = 483 + Height = 423 + Align = alClient + BevelOuter = bvNone + TabOrder = 0 + OnResize = panel_dataResize + object Splitter2: TSplitter + Left = 0 + Top = 300 + Width = 483 + Height = 9 + Cursor = crVSplit + Align = alTop + AutoSnap = False + Beveled = True + MinSize = 100 + end + object hex: TMPHexEditor + Left = 0 + Top = 0 + Width = 483 + Height = 300 + Cursor = crIBeam + Align = alTop + Font.Charset = DEFAULT_CHARSET + Font.Color = clWindowText + Font.Height = -16 + Font.Name = 'Courier' + Font.Style = [] + ParentFont = False + TabOrder = 0 + BytesPerRow = 16 + Translation = tkASCII + OffsetFormat = '6!10:0x|' + Colors.Background = clWindow + Colors.ChangedBackground = clWindow + Colors.ChangedText = clRed + Colors.CursorFrame = clNavy + Colors.Offset = clBlack + Colors.OddColumn = clBlue + Colors.EvenColumn = clNavy + Colors.CurrentOffsetBackground = clBtnShadow + Colors.OffsetBackGround = clBtnFace + Colors.CurrentOffset = clBtnHighlight + Colors.Grid = clBtnFace + Colors.NonFocusCursorFrame = clAqua + Colors.ActiveFieldBackground = clWindow + FocusFrame = True + AllowInsertMode = False + DrawGridLines = False + Version = 'May 23, 2005; '#169' markus stephany, vcl[at]mirkes[dot]de' + OnChange = hexChange + ShowPositionIfNotFocused = True + OnSelectionChanged = hexSelectionChanged + end + object structs: TWrapGrid + Left = 0 + Top = 309 + Width = 483 + Height = 114 + Align = alClient + DefaultColWidth = 92 + DefaultRowHeight = 18 + FixedCols = 0 + Options = [goFixedVertLine, goFixedHorzLine, goVertLine, goHorzLine] + TabOrder = 1 + OnClick = structsClick + end + end + object panel_files: TPanel + Left = 0 + Top = 0 + Width = 150 + Height = 423 + Align = alLeft + BevelOuter = bvNone + TabOrder = 1 + object Bevel1: TBevel + Left = 0 + Top = 359 + Width = 150 + Height = 6 + Align = alBottom + Style = bsRaised + end + object list: TListBox + Left = 0 + Top = 0 + Width = 150 + Height = 315 + Align = alClient + ItemHeight = 13 + TabOrder = 0 + OnClick = listClick + end + object panel_extension: TPanel + Left = 0 + Top = 315 + Width = 150 + Height = 44 + Align = alBottom + BevelOuter = bvNone + TabOrder = 1 + OnResize = panel_extensionResize + object Label1: TLabel + Left = 2 + Top = 4 + Width = 100 + Height = 17 + AutoSize = False + Caption = 'Filter by extension:' + end + object combo_extension: TComboBox + Left = 2 + Top = 20 + Width = 145 + Height = 21 + Style = csDropDownList + DropDownCount = 12 + Font.Charset = DEFAULT_CHARSET + Font.Color = clWindowText + Font.Height = -11 + Font.Name = 'Tahoma' + Font.Style = [] + ItemHeight = 13 + ParentFont = False + Sorted = True + TabOrder = 0 + OnClick = combo_extensionClick + end + end + object panel_imexport: TPanel + Left = 0 + Top = 365 + Width = 150 + Height = 58 + Align = alBottom + BevelOuter = bvNone + TabOrder = 2 + OnResize = panel_imexportResize + object btn_export: TButton + Left = 4 + Top = 4 + Width = 142 + Height = 25 + Caption = '&Export to file...' + TabOrder = 0 + OnClick = btn_exportClick + end + object btn_import: TButton + Left = 4 + Top = 32 + Width = 142 + Height = 25 + Caption = '&Import from file...' + TabOrder = 1 + OnClick = btn_importClick + end + end + end + object opend: TOpenDialog + Options = [ofPathMustExist, ofFileMustExist, ofEnableSizing] + Left = 120 + Top = 392 + end + object saved: TSaveDialog + Options = [ofOverwritePrompt, ofPathMustExist, ofEnableSizing] + Left = 120 + Top = 368 + end +end Index: /oup/releases/0.18a2/Unit8_binedit.pas =================================================================== --- /oup/releases/0.18a2/Unit8_binedit.pas (revision 21) +++ /oup/releases/0.18a2/Unit8_binedit.pas (revision 21) @@ -0,0 +1,352 @@ +UNIT Unit8_binedit; +INTERFACE +USES + Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, + Dialogs, Wrapgrid, StdCtrls, Grids, StrUtils, MPHexEditor, ExtCtrls, + Unit3_data, Unit2_functions, Unit9_data_structures, Unit4_exporters; + +TYPE + TForm8 = Class(TForm) + Splitter1: TSplitter; + panel_data: TPanel; + hex: TMPHexEditor; + Splitter2: TSplitter; + structs: TWrapGrid; + panel_files: TPanel; + list: TListBox; + panel_extension: TPanel; + Label1: TLabel; + combo_extension: TComboBox; + Bevel1: TBevel; + panel_imexport: TPanel; + btn_export: TButton; + btn_import: TButton; + opend: TOpenDialog; + saved: TSaveDialog; + procedure FormActivate(Sender: TObject); + PROCEDURE btn_importClick(Sender: TObject); + PROCEDURE btn_exportClick(Sender: TObject); + PROCEDURE panel_imexportResize(Sender: TObject); + FUNCTION Save:Boolean; + PROCEDURE FormClose(Sender: TObject; var Action: TCloseAction); + PROCEDURE combo_extensionClick(Sender: TObject); + PROCEDURE panel_extensionResize(Sender: TObject); + FUNCTION GetValue(datatype:Byte; offset:LongWord):String; + PROCEDURE WriteStructureInfos(structinfoid:Integer); + PROCEDURE hexSelectionChanged(Sender: TObject); + PROCEDURE hexChange(Sender: TObject); + PROCEDURE panel_dataResize(Sender: TObject); + PROCEDURE structsClick(Sender: TObject); + PROCEDURE FormResize(Sender: TObject); + PROCEDURE ClearStructViewer; + PROCEDURE listClick(Sender: TObject); + PROCEDURE FormCloseQuery(Sender: TObject; var CanClose: Boolean); + PROCEDURE FormCreate(Sender: TObject); + PROCEDURE Recreatelist; + PRIVATE + PUBLIC + END; + +VAR + Form8: TForm8; + +IMPLEMENTATION +{$R *.dfm} +USES Unit1_main; +VAR + fileid:LongWord; + +FUNCTION IntToBin(value:Byte):String; + VAR i:Byte; + BEGIN + Result:=''; + FOR i:=7 DOWNTO 0 DO BEGIN + Result:=Result+IntToStr((value SHR i) AND $01); + END; + END; + +FUNCTION TForm8.GetValue(datatype:Byte; offset:LongWord):String; + VAR + data:Tdata; + BEGIN + CASE datatype OF + 1: Result:=IntToStr(Self.hex.data[offset]); + 2: Result:=IntToStr(Self.hex.data[offset]+Self.hex.data[offset+1]*256); + 3: Result:=IntToStr(Self.hex.data[offset]+Self.hex.data[offset+1]*256+Self.hex.data[offset+2]*256*256); + 4: Result:=IntToStr(Self.hex.data[offset]+Self.hex.data[offset+1]*256+Self.hex.data[offset+2]*256*256+Self.hex.data[offset+3]*256*256*256); + 5: Result:='0x'+IntToHex(Self.hex.data[offset],2); + 6: Result:='0x'+IntToHex(Self.hex.data[offset]+Self.hex.data[offset+1]*256,4); + 7: Result:='0x'+IntToHex(Self.hex.data[offset]+Self.hex.data[offset+1]*256+Self.hex.data[offset+2]*256*256,6); + 8: Result:='0x'+IntToHex(Self.hex.data[offset]+Self.hex.data[offset+1]*256+Self.hex.data[offset+2]*256*256+Self.hex.data[offset+3]*256*256*256,8); + 9: BEGIN + SetLength(data,4); + data[0]:=Self.hex.data[offset]; + data[1]:=Self.hex.data[offset+1]; + data[2]:=Self.hex.data[offset+2]; + data[3]:=Self.hex.data[offset+3]; + Result:=FloatToStr(Decode_Float(data)); + END; + 10: Result:=IntToBin(Self.hex.data[offset]); + END; + END; + +PROCEDURE TForm8.WriteStructureInfos(structinfoid:Integer); + VAR + i:Byte; + BEGIN + IF structinfoid>=0 THEN BEGIN + WITH structure_infos[structinfoid] DO BEGIN + Self.structs.RowCount:=Length(entries)+1; + FOR i:=1 TO Length(entries) DO BEGIN + Self.structs.Cells[0,i]:=entries[i-1].name; + Self.structs.Cells[1,i]:='0x'+IntToHex(entries[i-1].offset,6); + Self.structs.Cells[2,i]:=GetDataType(entries[i-1].datatype); + Self.structs.Cells[3,i]:=Self.GetValue(entries[i-1].datatype,entries[i-1].offset); + Self.structs.Cells[4,i]:=entries[i-1].description; + END; + END; + END; + END; + +PROCEDURE TForm8.Recreatelist; + VAR + i:LongWord; + BEGIN + combo_extension.Items.Clear; + combo_extension.Items.Add('_All files_ ('+IntToStr(dat_header.Files)+')'); + FOR i:=0 TO dat_header.Extensions-1 DO BEGIN + WITH dat_extensionsmap[i] DO BEGIN + combo_extension.Items.Add( + Extension[3]+Extension[2]+Extension[1]+Extension[0]+' ('+ + IntToStr(ExtCount)+')'); + END; + END; + combo_extension.ItemIndex:=0; + combo_extensionClick(Self); + END; + +PROCEDURE TForm8.FormCreate(Sender: TObject); + BEGIN + Self.Caption:=''; + fileid:=0; + structs.ColCount:=5; + structs.RowCount:=2; + structs.FixedRows:=1; + structs.Cells[0,0]:='Name'; + structs.Cells[1,0]:='Offset'; + structs.Cells[2,0]:='Type'; + structs.Cells[3,0]:='Value'; + structs.Cells[4,0]:='Description'; + structs.ColWidths[0]:=75; + structs.ColWidths[1]:=60; + structs.ColWidths[2]:=75; + structs.ColWidths[3]:=75; + Self.panel_dataResize(Self); + END; + +FUNCTION TForm8.Save:Boolean; + VAR + mem:TMemoryStream; + data:Tdata; + BEGIN + CASE MessageBox(Self.Handle,PChar('Save changes to file '+dat_files[fileid].FileName+'?'),PChar('Data changed...'),MB_YESNOCANCEL) OF + IDYES: BEGIN + mem:=TMemoryStream.Create; + hex.SaveToStream(mem); + mem.Seek(0,soFromBeginning); + SetLength(data,mem.Size); + mem.Read(data[0],mem.Size); + mem.Free; + SaveDatFile(fileid,data); + Result:=True; + END; + IDNO: Result:=True; + IDCANCEL: BEGIN + Result:=False; + END; + END; + END; + +PROCEDURE TForm8.FormCloseQuery(Sender: TObject; var CanClose: Boolean); + BEGIN + IF hex.Modified THEN BEGIN + IF NOT Save THEN CanClose:=False; + END; + END; + +PROCEDURE TForm8.listClick(Sender: TObject); + VAR + mem:TMemoryStream; + data:Tdata; + i:LongWord; + BEGIN + IF hex.Modified THEN BEGIN + IF NOT Save THEN BEGIN + FOR i:=0 TO list.Count-1 DO BEGIN + IF StrToInt(MidStr(list.Items.Strings[i],1,5))=fileid THEN BEGIN + list.ItemIndex:=i; + Exit; + END; + END; + END; + END; + Self.ClearStructViewer; + fileid:=StrToInt(MidStr(list.Items.Strings[list.ItemIndex],1,5)); + data:=LoadDatFile(fileid); + mem:=TMemoryStream.Create; + mem.Write(data[0],Length(data)); + hex.LoadFromStream(mem); + mem.Free; + WriteStructureInfos(GetStructureInfoId(dat_files[fileid].Extension)); + END; + +PROCEDURE TForm8.ClearStructViewer; + VAR + x:Word; + BEGIN + structs.RowCount:=2; + FOR x:=0 TO structs.ColCount-1 DO structs.Cells[x,1]:=''; + END; + +PROCEDURE TForm8.FormResize(Sender: TObject); + BEGIN + IF Self.Width>=650 THEN BEGIN + END ELSE Self.Width:=650; + IF Self.Height>=450 THEN BEGIN + END ELSE Self.Height:=450; + END; + +PROCEDURE TForm8.structsClick(Sender: TObject); + VAR + offset:LongWord; + length:Byte; + BEGIN + IF structs.Row>0 THEN BEGIN + offset:=structure_infos[GetStructureInfoId(dat_files[fileid].extension)].entries[structs.Row-1].offset; + length:=GetTypeDataLength(structure_infos[GetStructureInfoId(dat_files[fileid].extension)].entries[structs.Row-1].datatype); + hex.SelStart:=offset; + hex.SelEnd:=offset+length-1; + END; + END; + +PROCEDURE TForm8.panel_dataResize(Sender: TObject); + BEGIN + structs.ColWidths[4]:=structs.Width-structs.ColWidths[0]-structs.ColWidths[1]-structs.ColWidths[2]-structs.ColWidths[3]-28; + END; + +PROCEDURE TForm8.hexChange(Sender: TObject); + BEGIN + IF hex.DataSize>0 THEN + WriteStructureInfos(GetStructureInfoId(dat_files[fileid].Extension)); + END; + +PROCEDURE TForm8.hexSelectionChanged(Sender: TObject); + VAR + selstart:Integer; + i,j:Word; + BEGIN + FOR i:=1 TO structs.RowCount-1 DO BEGIN + FOR j:=0 TO structs.ColCount-1 DO BEGIN + structs.CellColors[j,i]:=clWhite; + structs.CellFontColors[j,i]:=clBlack; + END; + END; + IF hex.DataSize>0 THEN BEGIN + selstart:=hex.SelStart; + IF GetStructureInfoId(dat_files[fileid].Extension)>=0 THEN BEGIN + WITH structure_infos[GetStructureInfoId(dat_files[fileid].Extension)] DO BEGIN + FOR i:=0 TO High(entries) DO BEGIN + IF ((selstart-entries[i].offset)=0) THEN BEGIN + FOR j:=0 TO structs.ColCount-1 DO BEGIN + structs.CellColors[j,i+1]:=clBlue; + structs.CellFontColors[j,i+1]:=clWhite; + END; + structs.Row:=i+1; + END; + END; + END; + END; + END; + END; + +PROCEDURE TForm8.panel_extensionResize(Sender: TObject); + BEGIN + combo_extension.Width:=panel_extension.Width-5; + END; + +PROCEDURE TForm8.combo_extensionClick(Sender: TObject); + VAR + Extension:String[4]; + i:LongWord; + BEGIN + Extension:=MidStr(combo_extension.Items.Strings[combo_extension.ItemIndex],1,4); + list.Items.Clear; + IF Extension='_All' THEN BEGIN + FOR i:=0 TO dat_header.Files-1 DO + IF (dat_files[i].FileType AND $02)=0 THEN + list.Items.Add(dat_files[i].FileName); + END ELSE BEGIN + FOR i:=0 TO dat_header.Files-1 DO + IF dat_files[i].Extension=Extension THEN + IF (dat_files[i].FileType AND $02)=0 THEN + list.Items.Add(dat_files[i].FileName); + END; + IF list.Count>0 THEN BEGIN + list.ItemIndex:=0; + listClick(Self); + END; + END; + +PROCEDURE TForm8.FormClose(Sender: TObject; var Action: TCloseAction); + BEGIN + Action:=caFree; + Form1.close_window(Self.Name); + END; + +PROCEDURE TForm8.panel_imexportResize(Sender: TObject); + BEGIN + btn_import.Width:=panel_imexport.Width-8; + btn_export.Width:=panel_imexport.Width-8; + END; + +PROCEDURE TForm8.btn_exportClick(Sender: TObject); + BEGIN + saved.Filter:='Files of matching extension (*.'+dat_files[fileid].Extension+')|*.'+dat_files[fileid].Extension+'|All files|*.*'; + saved.DefaultExt:=dat_files[fileid].Extension; + IF saved.Execute THEN BEGIN + ExportDatFile(fileid,saved.FileName); + END; + END; + +PROCEDURE TForm8.btn_importClick(Sender: TObject); + VAR + data:Tdata; + fs:TFileStream; + BEGIN + opend.Filter:='Files of matching extension (*.'+dat_files[fileid].Extension+')|*.'+dat_files[fileid].Extension+'|All files|*.*'; + IF opend.Execute THEN BEGIN + fs:=TFileStream.Create(opend.FileName,fmOpenRead); + IF fs.Size<>dat_files[fileid].size THEN BEGIN + ShowMessage('Can''t import '+ExtractFilename(opend.FileName)+ + ', file has to have same size as file in .dat.'+CrLf+ + 'Size of file in .dat: '+FormatFileSize(dat_files[fileid].size)+CrLf+ + 'Size of chosen file: '+FormatFileSize(fs.Size)); + END ELSE BEGIN + SetLength(data,fs.Size); + fs.Read(data[0],fs.Size); + fs.Free; + fs:=TFileStream.Create(dat_filename,fmOpenReadWrite); + fs.Seek(dat_files[fileid].dataddr,soFromBeginning); + fs.Write(data[0],Length(data)); + END; + fs.Free; + listClick(Self); + END; + END; + +PROCEDURE TForm8.FormActivate(Sender: TObject); + BEGIN + Form1.SetActiveWindow(Self.Name); + END; + +END. Index: /oup/releases/0.18a2/Unit9_data_structures.pas =================================================================== --- /oup/releases/0.18a2/Unit9_data_structures.pas (revision 21) +++ /oup/releases/0.18a2/Unit9_data_structures.pas (revision 21) @@ -0,0 +1,113 @@ +UNIT Unit9_data_structures; +INTERFACE +USES SysUtils; + +TYPE + Tstructure_entry=RECORD + name:String; + offset:LongWord; + datatype:Byte; // 1..4: Integer[1..4] dec; 5..8: Integer[1..4] hex; 9: float; 10: bitset; 11+: string[1+] + description:String; + END; + Tstructure_info=RECORD + extension:String; + typedesc:String; + entries:Array OF Tstructure_entry; + END; + Tstructures=Array OF Tstructure_info; + +VAR + structure_infos:Tstructures; + + +FUNCTION GetDataType(typeid:Byte):String; +FUNCTION GetStructureInfoId(ext:String):Integer; +FUNCTION GetTypeDataLength(datatype:Byte):Byte; + + + +IMPLEMENTATION + +FUNCTION GetTypeDataLength(datatype:Byte):Byte; + BEGIN + CASE datatype OF + 1..4: Result:=datatype; + 5..8: Result:=datatype-4; + 9: Result:=4; + 10: Result:=1; + 11..255: Result:=datatype-10; + END; + END; + + +FUNCTION GetStructureInfoId(ext:String):Integer; + VAR + i:Integer; + BEGIN + FOR i:=0 TO High(structure_infos) DO BEGIN + IF structure_infos[i].extension=ext THEN BEGIN + Result:=i; + Exit; + END; + END; + Result:=-1; + END; + + +FUNCTION GetDataType(typeid:Byte):String; + BEGIN + CASE typeid OF + 1..4: Result:='Int'+IntToStr(typeid*8); + 5..8: Result:='Int'+IntToStr((typeid-4)*8); + 9: Result:='Float'; + 10: Result:='BitSet'; + 11..255: Result:='String('+IntToStr(typeid-10)+')'; + END; + END; + + +PROCEDURE AddEntry(_ext:String; _name:String; _offset:LongWord; _datatype:Byte; _description:String); + VAR + sid:Integer; + BEGIN + sid:=GetStructureInfoId(_ext); + IF sid>=0 THEN BEGIN + WITH structure_infos[sid] DO BEGIN + SetLength(entries,Length(entries)+1); + WITH entries[High(entries)] DO BEGIN + name:=_name; + offset:=_offset; + datatype:=_datatype; + description:=_description; + END; + END; + END; + END; + + +PROCEDURE AddExtension(_ext:String; _typedesc:String); + BEGIN + IF GetStructureInfoId(_ext)<0 THEN BEGIN + SetLength(structure_infos,Length(structure_infos)+1); + WITH structure_infos[High(structure_infos)] DO BEGIN + extension:='TXMP'; + typedesc:='Texture'; + END; + END; + END; + + +BEGIN + AddExtension('TXMP','Texture'); + AddEntry('TXMP','ID',$00,8,'ID of this file'); + AddEntry('TXMP','LevelID',$04,8,'ID of the level this file is in'); + AddEntry('TXMP','FileName',$08,138,''); + AddEntry('TXMP','Fading',$88,10,'Fading-Bitset'); + AddEntry('TXMP','Depth',$89,10,'Depth-Bitset'); + AddEntry('TXMP','Width',$8C,2,'x-resolution of image'); + AddEntry('TXMP','Height',$8E,2,'y-resolution of image'); + AddEntry('TXMP','Storetype',$90,10,'Storetype-Bitset'); + AddEntry('TXMP','TXAN-Link',$94,8,'Link to the TXAN-file (if this TXMP is the first image of an animation)'); + AddEntry('TXMP','TXMP-Link',$98,8,'Link to another TXMP-file'); + AddEntry('TXMP','Raw-Link',$9C,8,'Address of the image data in the .raw-file'); +END. Index: /oup/releases/0.19a/OniUnPacker.bdsproj =================================================================== --- /oup/releases/0.19a/OniUnPacker.bdsproj (revision 21) +++ /oup/releases/0.19a/OniUnPacker.bdsproj (revision 21) @@ -0,0 +1,171 @@ + + + + + + + + + + + + OniUnPacker.dpr + + + 7.0 + + + 8 + 0 + 1 + 1 + 0 + 0 + 1 + 1 + 1 + 0 + 0 + 1 + 0 + 1 + 1 + 1 + 0 + 0 + 0 + 0 + 0 + 1 + 0 + 1 + 1 + 1 + True + True + WinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE; + + False + + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + False + False + False + True + True + True + + + 0 + 0 + 1 + False + False + False + 16384 + 1048576 + 4194304 + + + + + + + + + xmlrtl;rtl;vcl;vclie;inet;inetdbbde;inetdbxpress;vclx;IndySystem;IndyCore;dbrtl;dsnap;soaprtl;IndyProtocols;bdertl;vcldbx;vcldb;webdsnap;websnap;vclactnband;GridPackd2005;TWrapGrid;Package1;A406_R70;CoolTrayIcon_D6plus + + + False + + + + + + False + + + + + + False + + + False + False + 1 + 0 + 0 + 0 + False + False + False + False + False + 1031 + 1252 + + + + + 1.0.0.0 + + + + + + 1.0.0.0 + + + (untitled) + Borland Web Wizard Package + + + Index: /oup/releases/0.19a/OniUnPacker.cfg =================================================================== --- /oup/releases/0.19a/OniUnPacker.cfg (revision 21) +++ /oup/releases/0.19a/OniUnPacker.cfg (revision 21) @@ -0,0 +1,38 @@ +-$A8 +-$B- +-$C+ +-$D+ +-$E- +-$F- +-$G+ +-$H+ +-$I+ +-$J- +-$K- +-$L+ +-$M- +-$N+ +-$O+ +-$P+ +-$Q- +-$R- +-$S- +-$T- +-$U- +-$V+ +-$W- +-$X+ +-$YD +-$Z1 +-cg +-AWinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE; +-H+ +-W+ +-M +-$M16384,1048576 +-K$00400000 +-LE"C:\Dokumente und Einstellungen\Administrator\Eigene Dateien\Borland Studio Projects\Bpl" +-LN"C:\Dokumente und Einstellungen\Administrator\Eigene Dateien\Borland Studio Projects\Bpl" +-w-UNSAFE_TYPE +-w-UNSAFE_CODE +-w-UNSAFE_CAST Index: /oup/releases/0.19a/OniUnPacker.dpr =================================================================== --- /oup/releases/0.19a/OniUnPacker.dpr (revision 21) +++ /oup/releases/0.19a/OniUnPacker.dpr (revision 21) @@ -0,0 +1,24 @@ +PROGRAM OniUnPacker; +uses + Forms, + Unit1_main in 'Unit1_main.pas' {Form1}, + Unit2_functions in 'Unit2_functions.pas', + Unit3_data in 'Unit3_data.pas', + Unit4_Exporters in 'Unit4_Exporters.pas', + Unit5_preview in 'Unit5_preview.pas' {Form5}, + Unit6_imgfuncs in 'Unit6_imgfuncs.pas', + Unit7_txmpreplace in 'Unit7_txmpreplace.pas' {Form7}, + Unit8_binedit in 'Unit8_binedit.pas' {Form8}, + Unit9_data_structures in 'Unit9_data_structures.pas', + Unit10_leveldb in 'Unit10_leveldb.pas' {Form10}, + Unit11_extractor in 'Unit11_extractor.pas' {Form11}; + +{$R *.res} + +BEGIN + Application.Initialize; + Application.Title:='Oni Un/Packer'; + Application.CreateForm(TForm1, Form1); + Application.CreateForm(TForm10, Form10); + Application.Run; +END. Index: /oup/releases/0.19a/SQLite3.pas =================================================================== --- /oup/releases/0.19a/SQLite3.pas (revision 21) +++ /oup/releases/0.19a/SQLite3.pas (revision 21) @@ -0,0 +1,120 @@ +unit SQLite3; + +{ + Simplified interface for SQLite. + Updated for Sqlite 3 by Tim Anderson (tim@itwriting.com) + Note: NOT COMPLETE for version 3, just minimal functionality + Adapted from file created by Pablo Pissanetzky (pablo@myhtpc.net) + which was based on SQLite.pas by Ben Hochstrasser (bhoc@surfeu.ch) +} + +interface + +const +// Return values for sqlite3_exec() and sqlite3_step() + +SQLITE_OK = 0; // Successful result +SQLITE_ERROR = 1; // SQL error or missing database +SQLITE_INTERNAL = 2; // An internal logic error in SQLite +SQLITE_PERM = 3 ; // Access permission denied +SQLITE_ABORT = 4; // Callback routine requested an abort +SQLITE_BUSY = 5; // The database file is locked +SQLITE_LOCKED = 6; // A table in the database is locked +SQLITE_NOMEM = 7; // A malloc() failed +SQLITE_READONLY = 8; // Attempt to write a readonly database +SQLITE_INTERRUPT = 9; // Operation terminated by sqlite3_interrupt() +SQLITE_IOERR = 10; // Some kind of disk I/O error occurred +SQLITE_CORRUPT = 11; // The database disk image is malformed +SQLITE_NOTFOUND = 12; // (Internal Only) Table or record not found +SQLITE_FULL = 13; // Insertion failed because database is full +SQLITE_CANTOPEN = 14; // Unable to open the database file +SQLITE_PROTOCOL = 15; // Database lock protocol error +SQLITE_EMPTY = 16; // Database is empty +SQLITE_SCHEMA = 17; // The database schema changed +SQLITE_TOOBIG = 18; // Too much data for one row of a table +SQLITE_CONSTRAINT = 19; // Abort due to contraint violation +SQLITE_MISMATCH = 20; // Data type mismatch +SQLITE_MISUSE = 21; // Library used incorrectly +SQLITE_NOLFS = 22; // Uses OS features not supported on host +SQLITE_AUTH = 23; // Authorization denied +SQLITE_FORMAT = 24; // Auxiliary database format error +SQLITE_RANGE = 25; // 2nd parameter to sqlite3_bind out of range +SQLITE_NOTADB = 26; // File opened that is not a database file +SQLITE_ROW = 100; // sqlite3_step() has another row ready +SQLITE_DONE = 101; // sqlite3_step() has finished executing + +SQLITE_INTEGER = 1; +SQLITE_FLOAT = 2; +SQLITE_TEXT = 3; +SQLITE_BLOB = 4; +SQLITE_NULL = 5; + +type +TSQLiteDB = Pointer; +TSQLiteResult = ^PChar; +TSQLiteStmt = Pointer; + +function SQLite3_Open (dbname: PChar; var db: TSqliteDB): integer; cdecl; external 'sqlite3.dll' name 'sqlite3_open'; +function SQLite3_Close (db: TSQLiteDB): integer; cdecl; external 'sqlite3.dll' name 'sqlite3_close'; +function SQLite3_Exec (db: TSQLiteDB; SQLStatement: PChar; CallbackPtr: Pointer; Sender: TObject; var ErrMsg: PChar): integer; cdecl; external 'sqlite3.dll' name 'sqlite3_exec'; +function SQLite3_Version (): PChar; cdecl; external 'sqlite3.dll' name 'sqlite3_libversion'; +function SQLite3_ErrMsg (db: TSQLiteDB): PChar; cdecl; external 'sqlite3.dll' name 'sqlite3_errmsg'; +function SQLite3_ErrCode (db: TSQLiteDB): integer; cdecl; external 'sqlite3.dll' name 'sqlite3_errcode'; +procedure SQlite3_Free (P: PChar); cdecl; external 'sqlite3.dll' name 'sqlite3_free'; +function SQLite3_GetTable (db: TSQLiteDB; SQLStatement: PChar; var ResultPtr: TSQLiteResult; var RowCount: Cardinal; var ColCount: Cardinal; var ErrMsg: PChar): integer; cdecl; external 'sqlite3.dll' name 'sqlite3_get_table'; +procedure SQLite3_FreeTable (Table:TSQLiteResult ); cdecl; external 'sqlite3.dll' name 'sqlite3_free_table'; +function SQLite3_Complete (P: PChar): boolean; cdecl; external 'sqlite3.dll' name 'sqlite3_complete'; +function SQLite3_LastInsertRowID(db: TSQLiteDB): int64; cdecl; external 'sqlite3.dll' name 'sqlite3_last_insert_rowid'; +procedure SQLite3_Interrupt (db: TSQLiteDB); cdecl; external 'sqlite3.dll' name 'sqlite3_interrupt'; +procedure SQLite3_BusyHandler (db: TSQLiteDB; CallbackPtr: Pointer; Sender: TObject); cdecl; external 'sqlite3.dll' name'sqlite3_busy_handler' ; +procedure SQLite3_BusyTimeout (db: TSQLiteDB; TimeOut: integer); cdecl; external 'sqlite3.dll' name 'sqlite3_busy_timeout'; +function SQLite3_Changes (db: TSQLiteDB): integer; cdecl; external 'sqlite3.dll' name 'sqlite3_changes'; +function SQLite3_TotalChanges (db: TSQLiteDB): integer; cdecl; external 'sqlite3.dll' name 'sqlite3_total_changes'; +function SQLite3_Prepare (db: TSQLiteDB; SQLStatement: PChar; nBytes: integer; var hStmt: TSqliteStmt; var pzTail: PChar): integer; cdecl; external 'sqlite3.dll' name 'sqlite3_prepare'; +function SQLite3_ColumnCount (hStmt: TSqliteStmt): integer; cdecl; external 'sqlite3.dll' name 'sqlite3_column_count'; +function Sqlite3_ColumnName (hStmt: TSqliteStmt; ColNum: integer): pchar; cdecl; external 'sqlite3.dll' name 'sqlite3_column_name'; +function Sqlite3_ColumnDeclType (hStmt: TSqliteStmt; ColNum: integer): pchar; cdecl; external 'sqlite3.dll' name 'sqlite3_column_decltype'; +function Sqlite3_Step (hStmt: TSqliteStmt): integer; cdecl; external 'sqlite3.dll' name 'sqlite3_step'; +function SQLite3_DataCount (hStmt: TSqliteStmt): integer; cdecl; external 'sqlite3.dll' name 'sqlite3_data_count'; + +function Sqlite3_ColumnBlob (hStmt: TSqliteStmt; ColNum: integer):pointer; cdecl; external 'sqlite3.dll' name 'sqlite3_column_blob'; +function Sqlite3_ColumnBytes (hStmt: TSqliteStmt; ColNum: integer): integer; cdecl; external 'sqlite3.dll' name 'sqlite3_column_bytes'; +function Sqlite3_ColumnDouble (hStmt: TSqliteStmt; ColNum: integer): double; cdecl; external 'sqlite3.dll' name 'sqlite3_column_double'; +function Sqlite3_ColumnInt (hStmt: TSqliteStmt; ColNum: integer): integer; cdecl; external 'sqlite3.dll' name 'sqlite3_column_int'; +function Sqlite3_ColumnText (hStmt: TSqliteStmt; ColNum: integer): pchar; cdecl; external 'sqlite3.dll' name 'sqlite3_column_text'; +function Sqlite3_ColumnType (hStmt: TSqliteStmt; ColNum: integer): integer; cdecl; external 'sqlite3.dll' name 'sqlite3_column_type'; + // function Sqlite3_ColumnInt64 (hStmt: TSqliteStmt; ColNum: integer): SqliteInt64; cdecl; external 'sqlite3.dll' name 'sqlite3_column_int64'; +function SQLite3_Finalize (hStmt: TSqliteStmt): integer; cdecl; external 'sqlite3.dll' name 'sqlite3_finalize'; +function SQLite3_Reset (hStmt: TSqliteStmt): integer; cdecl; external 'sqlite3.dll' name 'sqlite3_reset'; + +// +// In the SQL strings input to sqlite3_prepare() and sqlite3_prepare16(), +// one or more literals can be replace by a wildcard "?" or ":N:" where +// N is an integer. These value of these wildcard literals can be set +// using the routines listed below. +// +// In every case, the first parameter is a pointer to the sqlite3_stmt +// structure returned from sqlite3_prepare(). The second parameter is the +// index of the wildcard. The first "?" has an index of 1. ":N:" wildcards +// use the index N. +// + // The fifth parameter to sqlite3_bind_blob(), sqlite3_bind_text(), and + //sqlite3_bind_text16() is a destructor used to dispose of the BLOB or +//text after SQLite has finished with it. If the fifth argument is the +// special value SQLITE_STATIC, then the library assumes that the information +// is in static, unmanaged space and does not need to be freed. If the +// fifth argument has the value SQLITE_TRANSIENT, then SQLite makes its +// own private copy of the data. +// +// The sqlite3_bind_* routine must be called before sqlite3_step() after +// an sqlite3_prepare() or sqlite3_reset(). Unbound wildcards are interpreted +// as NULL. +// + +function SQLite3_BindBlob(hStmt: TSqliteStmt; ParamNum: integer; +ptrData: pointer; numBytes: integer; ptrDestructor: pointer): integer; +cdecl; external 'sqlite3.dll' name 'sqlite3_bind_blob'; + +implementation + +end. Index: /oup/releases/0.19a/SQLiteTable3.pas =================================================================== --- /oup/releases/0.19a/SQLiteTable3.pas (revision 21) +++ /oup/releases/0.19a/SQLiteTable3.pas (revision 21) @@ -0,0 +1,885 @@ +unit SQLiteTable3; + +{ + Simple classes for using SQLite's exec and get_table. + + TSQLiteDatabase wraps the calls to open and close an SQLite database. + It also wraps SQLite_exec for queries that do not return a result set + + TSQLiteTable wraps sqlite_get_table. + It allows accessing fields by name as well as index and can step through a + result set with the Next procedure. + + Adapted by Tim Anderson (tim@itwriting.com) + Originally created by Pablo Pissanetzky (pablo@myhtpc.net) +} + +interface + +uses + Windows, SQLite3, Classes, Sysutils; + +const + dtStr = 0; + dtInt = 1; + dtBool = 2; + dtNumeric = 3; + dtBlob = 4; + +type + + ESQLiteException = class(Exception) + private + public + end; + + TSQLiteTable = class; + + TSQLiteDatabase = class + private + fDB: TSQLiteDB; + fInTrans: Boolean; + procedure RaiseError(s: string; SQL: string); + + public + constructor Create(const FileName: string); + destructor Destroy; override; + function GetTable(const SQL: string): TSQLiteTable; + procedure ExecSQL(const SQL: string); + procedure UpdateBlob(const SQL: string; BlobData: TStream); + procedure BeginTransaction; + procedure Commit; + procedure Rollback; + function TableExists(TableName: string): boolean; + function GetLastInsertRowID: int64; + + published + property isTransactionOpen: boolean read fInTrans; + + end; + + TSQLiteTable = class + private + fResults: TList; + fRowCount: Cardinal; + fColCount: Cardinal; + fCols: TStringList; + fColTypes: TList; + fRow: Cardinal; + + function GetFields(I: Integer): string; + function GetEOF: Boolean; + function GetBOF: Boolean; + function GetColumns(I: Integer): string; + function GetFieldByName(FieldName: string): string; + function GetFieldIndex(FieldName: string): integer; + function GetCount: Integer; + function GetCountResult: Integer; + + + public + constructor Create(DB: TSQLiteDatabase; const SQL: string); + destructor Destroy; override; + function FieldAsInteger(FieldName: string): integer; + function FieldAsBool(FieldName: string): boolean; + function FieldAsBlob(FieldName: string): TMemoryStream; + function FieldAsBlobText(FieldName: string): string; + function FieldIsNull(FieldName: string): boolean; + function FieldAsString(FieldName: string): string; + function FieldAsDouble(FieldName: string): double; +{ function FieldAsInteger(I: integer): integer; + function FieldAsBool(I: integer): boolean; + function FieldAsBlob(I: Integer): TMemoryStream; + function FieldAsBlobText(I: Integer): string; + function FieldIsNull(I: integer): boolean; + function FieldAsString(I: Integer): string; + function FieldAsDouble(I: Integer): double; +} function Next: Boolean; + function Previous: Boolean; + property EOF: Boolean read GetEOF; + property BOF: Boolean read GetBOF; + property Fields[I: Integer]: string read GetFields; + property FieldByName[FieldName: string]: string read GetFieldByName; + property FieldIndex[FieldName: string]: integer read GetFieldIndex; + property Columns[I: Integer]: string read GetColumns; + property ColCount: Cardinal read fColCount; + property RowCount: Cardinal read fRowCount; + property Row: Cardinal read fRow; + function MoveFirst: boolean; + function MoveLast: boolean; + + + property Count: Integer read GetCount; + + // The property CountResult is used when you execute count(*) queries. + // It returns 0 if the result set is empty or the value of the + // first field as an integer. + property CountResult: Integer read GetCountResult; + end; + + +procedure DisposePointer(ptr: pointer); cdecl; + +implementation + +uses + strutils; + + +procedure DisposePointer(ptr: pointer); cdecl; +begin + + if assigned(ptr) then + begin freemem(ptr) end; + +end; + +//------------------------------------------------------------------------------ +// TSQLiteDatabase +//------------------------------------------------------------------------------ + +constructor TSQLiteDatabase.Create(const FileName: string); +var + Msg: pchar; + iResult: integer; +begin + inherited Create; + + self.fInTrans := false; + + Msg := nil; + try + iResult := SQLite3_Open(PChar(FileName), Fdb); + + if iResult <> SQLITE_OK then + begin + if Assigned(Fdb) then + begin + Msg := Sqlite3_ErrMsg(Fdb); + raise ESqliteException.CreateFmt('Failed to open database "%s" : %s', [FileName, Msg]); + end + else + begin raise ESqliteException.CreateFmt('Failed to open database "%s" : unknown error', [FileName]) end; + end; + + //set a few configs + self.ExecSQL('PRAGMA SYNCHRONOUS=NORMAL;'); + + //this pragma not recommended and may disappear in future + //sqlite versions + //self.ExecSQL('PRAGMA full_column_names = 1;'); + + finally + if Assigned(Msg) then + begin SQLite3_Free(Msg) end; + end; + + +end; + + +//.............................................................................. + +destructor TSQLiteDatabase.Destroy; +begin + + if self.fInTrans then + begin self.ExecSQL('ROLLBACK;') end; //assume rollback + + if Assigned(fDB) then + begin SQLite3_Close(fDB) end; + + inherited; +end; + +function TSQLiteDatabase.GetLastInsertRowID: int64; +begin + result := Sqlite3_LastInsertRowID(self.fDB); +end; + +//.............................................................................. + +procedure TSQLiteDatabase.RaiseError(s: string; SQL: string); +//look up last error and raise and exception with an appropriate message +var + Msg: PChar; +begin + + Msg := nil; + + if sqlite3_errcode(self.fDB) <> SQLITE_OK then + Msg := sqlite3_errmsg(self.fDB); + + IF Pos('DROP TABLE ',SQL)>0 THEN Exit; + + if Msg <> nil then + raise ESqliteException.CreateFmt(s + ' "%s" : %s', [SQL, Msg]) + else + raise ESqliteException.CreateFmt(s, [SQL, 'No message']); + +end; + +procedure TSQLiteDatabase.ExecSQL(const SQL: string); +var + Stmt: TSQLiteStmt; + NextSQLStatement: Pchar; + iStepResult: integer; +begin + try + + if Sqlite3_Prepare(self.fDB, PChar(SQL), -1, Stmt, NextSQLStatement) <> SQLITE_OK then + begin RaiseError('Error executing SQL', SQL) end; + + if (Stmt = nil) then + begin RaiseError('Could not prepare SQL statement', SQL) end; + + iStepResult := Sqlite3_step(Stmt); + + if (iStepResult <> SQLITE_DONE) then + begin RaiseError('Error executing SQL statement', SQL) end; + + finally + + if Assigned(Stmt) then + begin Sqlite3_Finalize(stmt) end; + + end; +end; + +procedure TSQLiteDatabase.UpdateBlob(const SQL: string; BlobData: TStream); +var + iSize: integer; + ptr: pointer; + Stmt: TSQLiteStmt; + Msg: Pchar; + NextSQLStatement: Pchar; + iStepResult: integer; + iBindResult: integer; +begin +//expects SQL of the form 'UPDATE MYTABLE SET MYFIELD = ? WHERE MYKEY = 1' + + if pos('?', SQL) = 0 then + begin RaiseError('SQL must include a ? parameter', SQL) end; + + Msg := nil; + try + + if Sqlite3_Prepare(self.fDB, PChar(SQL), -1, Stmt, NextSQLStatement) <> SQLITE_OK then + begin RaiseError('Could not prepare SQL statement', SQL) end; + + if (Stmt = nil) then + begin RaiseError('Could not prepare SQL statement', SQL) end; + +//now bind the blob data + iSize := BlobData.size; + + GetMem(ptr, iSize); + + if (ptr = nil) then + begin raise ESqliteException.CreateFmt('Error getting memory to save blob', [SQL, 'Error']) end; + + BlobData.position := 0; + BlobData.Read(ptr^, iSize); + + iBindResult := SQLite3_BindBlob(stmt, 1, ptr, iSize, @DisposePointer); + + if iBindResult <> SQLITE_OK then + begin RaiseError('Error binding blob to database', SQL) end; + + iStepResult := Sqlite3_step(Stmt); + + if (iStepResult <> SQLITE_DONE) then + begin RaiseError('Error executing SQL statement', SQL) end; + + finally + + if Assigned(Stmt) then + begin Sqlite3_Finalize(stmt) end; + + if Assigned(Msg) then + begin SQLite3_Free(Msg) end; + end; + +end; + +//.............................................................................. + +function TSQLiteDatabase.GetTable(const SQL: string): TSQLiteTable; +begin + Result := TSQLiteTable.Create(Self, SQL); +end; + +procedure TSQLiteDatabase.BeginTransaction; +begin + if not self.fInTrans then + begin + self.ExecSQL('BEGIN TRANSACTION;'); + self.fInTrans := true; + end + else + begin raise ESqliteException.Create('Transaction already open') end; +end; + +procedure TSQLiteDatabase.Commit; +begin + self.ExecSQL('COMMIT;'); + self.fInTrans := false; +end; + +procedure TSQLiteDatabase.Rollback; +begin + self.ExecSQL('ROLLBACK;'); + self.fInTrans := false; +end; + +function TSQLiteDatabase.TableExists(TableName: string): boolean; +var + sql: string; + ds: TSqliteTable; +begin +//returns true if table exists in the database + sql := 'select [sql] from sqlite_master where [type] = ''table'' and lower(name) = ''' + lowercase(TableName) + ''' '; + + try + + ds := self.GetTable(sql); + + result := (ds.Count > 0); + + finally + + freeandnil(ds); + + end; + +end; + + +//------------------------------------------------------------------------------ +// TSQLiteTable +//------------------------------------------------------------------------------ + +constructor TSQLiteTable.Create(DB: TSQLiteDatabase; const SQL: string); +var + Stmt: TSQLiteStmt; + NextSQLStatement: Pchar; + iStepResult: integer; + + ptr: pointer; + iNumBytes: integer; + thisBlobValue: TMemoryStream; + thisStringValue: pstring; + thisBoolValue: pBoolean; + thisDoubleValue: pDouble; + thisIntValue: pInteger; + thisColType: pInteger; + i: integer; + DeclaredColType: Pchar; + ActualColType: integer; + ptrValue: Pchar; + +begin + + try + + self.fRowCount := 0; + self.fColCount := 0; + +//if there are several SQL statements in SQL, NextSQLStatment points to the +//beginning of the next one. Prepare only prepares the first SQL statement. + + if Sqlite3_Prepare(Db.fDB, PChar(SQL), -1, Stmt, NextSQLStatement) <> SQLITE_OK then + begin Db.RaiseError('Error executing SQL', SQL) end; + + if (Stmt = nil) then + begin Db.RaiseError('Could not prepare SQL statement', SQL) end; + + iStepResult := Sqlite3_step(Stmt); + + while (iStepResult <> SQLITE_DONE) do + begin + + case iStepResult of + SQLITE_ROW: + begin + + inc(fRowCount); + + if (fRowCount = 1) then + begin + //get data types + fCols := TStringList.Create; + fCols.CaseSensitive := False; + fColTypes := TList.Create; + + fColCount := SQLite3_ColumnCount(stmt); + + for i := 0 to Pred(fColCount) do + begin + fCols.Add(Sqlite3_ColumnName(stmt, i)); + end; + + for i := 0 to Pred(fColCount) do + begin + + new(thisColType); + DeclaredColType := Sqlite3_ColumnDeclType(stmt, i); + + if DeclaredColType = nil then begin + //use the actual column type instead + //seems to be needed for last_insert_rowid + thisColType^ := Sqlite3_ColumnType(stmt, i); + end else begin + DeclaredColType := strupper(DeclaredColType); + + if DeclaredColType = 'INTEGER' then + begin thisColType^ := dtInt end + else + if DeclaredColType = 'BOOLEAN' then + begin thisColType^ := dtBool end + else + if (DeclaredColType = 'NUMERIC') or (DeclaredColType = 'FLOAT') or (DeclaredColType = 'DOUBLE') then + begin thisColType^ := dtNumeric end + else + if DeclaredColType = 'BLOB' then + begin thisColType^ := dtBlob end + else + begin thisColType^ := dtStr end; + end; + + fColTypes.Add(thiscoltype); + end; + + fResults := TList.Create; + + end; + + //get column values + for i := 0 to Pred(ColCount) do + begin + + ActualColType := Sqlite3_ColumnType(stmt, i); + if (ActualColType = SQLITE_NULL) then + begin fResults.Add(nil) end + else + begin + if pInteger(fColTypes[i])^ = dtInt then + begin + new(thisintvalue); + thisintvalue^ := Sqlite3_ColumnInt(stmt, i); + fResults.Add(thisintvalue); + end + else + if pInteger(fColTypes[i])^ = dtBool then + begin + new(thisboolvalue); + thisboolvalue^ := not (Sqlite3_ColumnInt(stmt, i) = 0); + fResults.Add(thisboolvalue); + end + else + if pInteger(fColTypes[i])^ = dtNumeric then + begin + new(thisdoublevalue); + thisdoublevalue^ := Sqlite3_ColumnDouble(stmt, i); + fResults.Add(thisdoublevalue); + end + else + if pInteger(fColTypes[i])^ = dtBlob then + begin + iNumBytes := Sqlite3_ColumnBytes(stmt, i); + + if iNumBytes = 0 then + begin thisblobvalue := nil end + else + begin + thisblobvalue := TMemoryStream.Create; + thisblobvalue.position := 0; + ptr := Sqlite3_ColumnBlob(stmt, i); + thisblobvalue.writebuffer(ptr^, iNumBytes); + end; + fResults.Add(thisblobvalue); + + end + else + begin + new(thisstringvalue); + ptrValue := Sqlite3_ColumnText(stmt, i); + setstring(thisstringvalue^, ptrvalue, strlen(ptrvalue)); + fResults.Add(thisstringvalue); + end; + end; + + end; + + + + end; + + SQLITE_BUSY: + begin raise ESqliteException.CreateFmt('Could not prepare SQL statement', [SQL, 'SQLite is Busy']) end; + else + begin Db.RaiseError('Could not retrieve data', SQL) end; + end; + + iStepResult := Sqlite3_step(Stmt); + + end; + + fRow := 0; + + finally + if Assigned(Stmt) then + begin Sqlite3_Finalize(stmt) end; + end; + +end; + +//.............................................................................. + +destructor TSQLiteTable.Destroy; +var i: integer; + iColNo: integer; +begin + + + if Assigned(fResults) then + begin for i := 0 to fResults.Count - 1 do + begin + //check for blob type + iColNo := (i mod fColCount); + case pInteger(self.fColTypes[iColNo])^ of + dtBlob: + begin + TMemoryStream(fResults[i]).free; + end; + dtStr: + begin + if fResults[i] <> nil then + begin + setstring(string(fResults[i]^), nil, 0); + dispose(fResults[i]); + end; + end; + else + begin + dispose(fResults[i]) + end; + end; + end; + fResults.Free; + end; + + if Assigned(fCols) then + begin fCols.Free end; + + if Assigned(fColTypes) then + begin for i := 0 to fColTypes.Count - 1 do + begin + dispose(fColTypes[i]); + end end; + fColTypes.Free; + inherited; + end; + +//.............................................................................. + +function TSQLiteTable.GetColumns(I: Integer): string; +begin + Result := fCols[I]; +end; + +//.............................................................................. + +function TSQLiteTable.GetCountResult: Integer; +begin + if not EOF then + begin Result := StrToInt(Fields[0]) end + else + begin Result := 0 end; +end; + +function TSQLiteTable.GetCount: Integer; +begin + Result := FRowCount; +end; + +//.............................................................................. + +function TSQLiteTable.GetEOF: Boolean; +begin + Result := fRow >= fRowCount; +end; + +function TSQLiteTable.GetBOF: Boolean; +begin + Result := fRow <= 0; +end; + +//.............................................................................. + +function TSQLiteTable.GetFieldByName(FieldName: string): string; +begin + Result := GetFields(self.GetFieldIndex(FieldName)); +end; + +function TSQLiteTable.GetFieldIndex(FieldName: string): integer; +begin + + if (fCols = nil) then + begin + raise ESqliteException.Create('Field ' + fieldname + ' Not found. Empty dataset'); + exit; + end; + + if (fCols.count = 0) then + begin + raise ESqliteException.Create('Field ' + fieldname + ' Not found. Empty dataset'); + exit; + end; + + result := fCols.IndexOf(FieldName); + + if (result < 0) then + begin raise ESqliteException.Create('Field not found in dataset: ' + fieldname) end; + +end; + +//.............................................................................. + +function TSQLiteTable.GetFields(I: Integer): string; +var + thisvalue: pstring; + ptr: pointer; + thisboolvalue: pBoolean; + thistype: integer; +begin + Result := ''; + + if EOF then + begin raise ESqliteException.Create('Table is at End of File') end; + +//integer and boolean types are not stored in the resultset +//as strings, so they should be retrieved using the type-specific +//methods + + thistype := pInteger(self.fColTypes[I])^; + + if (thistype = dtInt) or (thistype = dtNumeric) or (thistype = dtBlob) then + begin + ptr := self.fResults[(self.frow * self.fColCount) + I]; + + if ptr <> nil then + begin + raise ESqliteException.Create('Use the specific methods for integer, numeric or blob fields'); + end; + + end + else + if pInteger(self.fColTypes[I])^ = dtBool then + begin + thisboolvalue := self.fResults[(self.frow * self.fColCount) + I]; + if thisboolvalue <> nil then + begin if thisboolvalue^ then + begin result := '1' end + else + begin result := '0' end end; + end + + else + + begin + + thisvalue := self.fResults[(self.frow * self.fColCount) + I]; + if (thisvalue <> nil) then + begin Result := thisvalue^ end + else + begin Result := '' end; //return empty string + end; + +end; + +function TSqliteTable.FieldAsBlob(FieldName: string): TMemoryStream; +var + i: Integer; +begin + + if EOF then + begin raise ESqliteException.Create('Table is at End of File') end; + + i:=Self.FieldIndex[FieldName]; + + if (self.fResults[(self.frow * self.fColCount) + I] = nil) then + begin result := nil end + else + if pInteger(self.fColTypes[I])^ = dtBlob then + begin result := TMemoryStream(self.fResults[(self.frow * self.fColCount) + I]) end + else + begin raise ESqliteException.Create('Not a Blob field') end; +end; + +function TSqliteTable.FieldAsBlobText(FieldName: string): string; +var + MemStream: TMemoryStream; + Buffer: PChar; +begin + result := ''; + + MemStream := self.FieldAsBlob(FieldName); + + if MemStream <> nil then + begin if MemStream.Size > 0 then + begin + MemStream.position := 0; + + Buffer := stralloc(MemStream.Size + 1); + MemStream.readbuffer(Buffer[0], MemStream.Size); + (Buffer + MemStream.Size)^ := chr(0); + SetString(Result, Buffer, MemStream.size); + strdispose(Buffer); + end end; + +end; + + +function TSqliteTable.FieldAsInteger(FieldName: string): integer; +var + i: Integer; +begin + + if EOF then + begin raise ESqliteException.Create('Table is at End of File') end; + + i:=Self.FieldIndex[FieldName]; + + if (self.fResults[(self.frow * self.fColCount) + I] = nil) then + begin result := 0 end + else + if pInteger(self.fColTypes[I])^ = dtInt then + begin result := pInteger(self.fResults[(self.frow * self.fColCount) + I])^ end + else + if pInteger(self.fColTypes[I])^ = dtNumeric then + begin result := trunc(strtofloat(pString(self.fResults[(self.frow * self.fColCount) + I])^)) end + else + begin raise ESqliteException.Create('Not an integer or numeric field') end; + +end; + +function TSqliteTable.FieldAsDouble(FieldName: string): double; +var + i: Integer; +begin + + if EOF then + begin raise ESqliteException.Create('Table is at End of File') end; + + i:=Self.FieldIndex[FieldName]; + + if (self.fResults[(self.frow * self.fColCount) + I] = nil) then + begin result := 0 end + else + if pInteger(self.fColTypes[I])^ = dtInt then + begin result := pInteger(self.fResults[(self.frow * self.fColCount) + I])^ end + else + if pInteger(self.fColTypes[I])^ = dtNumeric then + begin result := pDouble(self.fResults[(self.frow * self.fColCount) + I])^ end + else + begin raise ESqliteException.Create('Not an integer or numeric field') end; + +end; + +function TSqliteTable.FieldAsBool(FieldName: string): boolean; +var + i: Integer; +begin + + if EOF then + begin raise ESqliteException.Create('Table is at End of File') end; + + i:=Self.FieldIndex[FieldName]; + + if (self.fResults[(self.frow * self.fColCount) + I] = nil) then + begin result := false end + else + if pInteger(self.fColTypes[I])^ = dtBool then + begin result := pBoolean(self.fResults[(self.frow * self.fColCount) + I])^ end + else + begin raise ESqliteException.Create('Not a boolean field') end; +end; + +function TSqliteTable.FieldAsString(FieldName: string): string; +var + i: Integer; +begin + + if EOF then + begin raise ESqliteException.Create('Table is at End of File') end; + + i:=Self.FieldIndex[FieldName]; + + if (self.fResults[(self.frow * self.fColCount) + I] = nil) then + begin result := '' end + else + begin result := self.GetFields(I) end; + +end; + +function TSqliteTable.FieldIsNull(FieldName: string): boolean; +var + thisvalue: pointer; + i: Integer; +begin + + if EOF then + begin raise ESqliteException.Create('Table is at End of File') end; + + i:=Self.FieldIndex[FieldName]; + + thisvalue := self.fResults[(self.frow * self.fColCount) + I]; + result := (thisvalue = nil); +end; + +//.............................................................................. + +function TSQLiteTable.Next: boolean; +begin + result := false; + if not EOF then + begin + Inc(fRow); + result := true; + end; +end; + +function TSQLiteTable.Previous: boolean; +begin + result := false; + if not BOF then + begin + Dec(fRow); + result := true; + end; +end; + +function TSQLiteTable.MoveFirst: boolean; +begin + result := false; + if self.fRowCount > 0 then + begin + fRow := 0; + result := true; + end; +end; + +function TSQLiteTable.MoveLast: boolean; +begin + result := false; + if self.fRowCount > 0 then + begin + fRow := fRowCount - 1; + result := true; + end; +end; + + +end. + Index: /oup/releases/0.19a/Unit10_leveldb.dfm =================================================================== --- /oup/releases/0.19a/Unit10_leveldb.dfm (revision 21) +++ /oup/releases/0.19a/Unit10_leveldb.dfm (revision 21) @@ -0,0 +1,61 @@ +object Form10: TForm10 + Left = 0 + Top = 0 + BorderStyle = bsNone + Caption = 'Creating DB' + ClientHeight = 90 + ClientWidth = 401 + Color = clBtnFace + Font.Charset = DEFAULT_CHARSET + Font.Color = clWindowText + Font.Height = -11 + Font.Name = 'Tahoma' + Font.Style = [] + OldCreateOrder = False + Position = poScreenCenter + PixelsPerInch = 96 + TextHeight = 13 + object group_progress: TGroupBox + Left = 0 + Top = 0 + Width = 400 + Height = 89 + Caption = 'Progress ...' + TabOrder = 0 + object lbl_progress: TLabel + Left = 2 + Top = 32 + Width = 396 + Height = 17 + Align = alTop + AutoSize = False + end + object lbl_estimation: TLabel + Left = 2 + Top = 49 + Width = 396 + Height = 17 + Align = alTop + AutoSize = False + Caption = 'Estimated finishing time:' + end + object progress: TProgressBar + Left = 2 + Top = 15 + Width = 396 + Height = 17 + Align = alTop + Smooth = True + TabOrder = 0 + end + object btn_abortok: TButton + Left = 3 + Top = 64 + Width = 60 + Height = 22 + Caption = 'Abort...' + TabOrder = 1 + OnClick = btn_abortokClick + end + end +end Index: /oup/releases/0.19a/Unit10_leveldb.pas =================================================================== --- /oup/releases/0.19a/Unit10_leveldb.pas (revision 21) +++ /oup/releases/0.19a/Unit10_leveldb.pas (revision 21) @@ -0,0 +1,984 @@ +UNIT Unit10_leveldb; +INTERFACE +USES + Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, + Dialogs, ComCtrls, StdCtrls; + +TYPE + TForm10 = Class(TForm) + group_progress: TGroupBox; + progress: TProgressBar; + lbl_progress: TLabel; + btn_abortok: TButton; + lbl_estimation: TLabel; + PROCEDURE btn_abortokClick(Sender: TObject); + PRIVATE + PROCEDURE HandleFile(ext:String; fileid:LongWord; dir_dat2db:Boolean); + PROCEDURE stop_convert; + PUBLIC + PROCEDURE CreateDatabase(FileName:String); + END; + + +VAR + Form10: TForm10; + +IMPLEMENTATION +{$R *.dfm} +USES SQLiteTable3, Unit1_main, Unit2_functions, Unit3_data; +TYPE + THandler=PROCEDURE(fileid:LongWord; dir_dat2db:Boolean); + TConvertHandlers=RECORD + Ext:String[4]; + needed:Boolean; + Handler:THandler; + END; +VAR + ConvertHandlers:Array OF TConvertHandlers; + loaded_filename:String; + converting:Boolean=False; + abort:Boolean=False; + filestream:TFileStream; + dat_stream,mem:TMemoryStream; + +PROCEDURE TForm10.HandleFile; + VAR + i:Byte; + BEGIN + FOR i:=1 TO Length(ConvertHandlers) DO + IF UpperCase(ConvertHandlers[i].Ext)=UpperCase(ext) THEN + IF ConvertHandlers[i].needed THEN BEGIN + ConvertHandlers[i].Handler(fileid, dir_dat2db); + Break; + END ELSE + Break; + END; + +PROCEDURE TForm10.CreateDatabase(FileName:String); + VAR + i,j:LongWord; + temps,temps2:String; + data:Tdata; + absolutebegintime,begintime:Double; + step:Byte; + CONST + steps:Byte=4; + PROCEDURE DoStep(stepname:String); + BEGIN + Inc(step); + IF stepname<>'FIN' THEN + group_progress.Caption:='Creating DB (Step '+IntToStr(step)+'/'+IntToStr(steps)+': '+stepname+')' + ELSE + group_progress.Caption:='Creating DB (FINISHED)'; + END; + BEGIN + Form10.Visible:=True; + Form1.Visible:=False; + step:=0; + converting:=True; + abort:=False; + loaded_filename:=FileName; + btn_abortok.Caption:='&Abort...'; + btn_abortok.Default:=False; + + absolutebegintime:=Time; + + DB:=TSQLiteDatabase.Create(FileName); + DB.ExecSQL('PRAGMA synchronous = 0;'); + DB.ExecSQL('PRAGMA temp_store = 2;'); + DB.ExecSQL('DROP TABLE globals;'); + DB.ExecSQL('DROP TABLE linkmap;'); + DB.ExecSQL('DROP TABLE rawmap;'); + DB.ExecSQL('DROP TABLE datfiles;'); + DB.ExecSQL('DROP TABLE extlist;'); + DB.ExecSQL('VACUUM;'); + + DoStep('Creating tables'); + progress.Position:=0; + lbl_progress.Caption:=''; + lbl_estimation.Caption:='Estimated finishing time: unknown'; + Application.ProcessMessages; + + DB.ExecSQL('CREATE TABLE globals (id INTEGER PRIMARY KEY AUTOINCREMENT, name VARCHAR (20), value VARCHAR (50) );'); + DB.ExecSQL('CREATE TABLE linkmap (id INTEGER PRIMARY KEY AUTOINCREMENT, src_id INTEGER, src_link_offset INTEGER, target_id INTEGER );'); + DB.ExecSQL('CREATE TABLE rawmap (id INTEGER PRIMARY KEY AUTOINCREMENT, src_id INTEGER, src_link_offset INTEGER, data BLOB );'); + DB.ExecSQL('CREATE TABLE datfiles (id INTEGER PRIMARY KEY, extension VARCHAR(4), name VARCHAR(128), contenttype INTEGER, data BLOB );'); + DB.ExecSQL('CREATE TABLE extlist (id INTEGER PRIMARY KEY AUTOINCREMENT, ext VARCHAR(4), ident VARCHAR(16) );'); + + DB.ExecSQL('INSERT INTO globals (name,value) VALUES ("dbversion","'+dbversion+'");'); + SetLength(data,Length(dat_header.Ident)); + FOR i:=0 TO High(dat_header.Ident) DO data[i]:=dat_header.Ident[i]; + temps:=CreateHexString(data,True); + DB.ExecSQL('INSERT INTO globals (name,value) VALUES ("ident","'+temps+'");'); + data:=LoadDatFile(0); + i:=data[7]; + i:=i DIV 2; + DB.ExecSQL('INSERT INTO globals (name,value) VALUES ("lvl","'+IntToStr(i)+'");'); + + DoStep('Writing extensionslist'); + progress.Max:=dat_header.Extensions; + Application.ProcessMessages; + + FOR i:=0 TO dat_header.Extensions-1 DO BEGIN + SetLength(data,Length(dat_extensionsmap[i].Ident)); + FOR j:=0 TO High(dat_extensionsmap[i].Ident) DO data[j]:=dat_extensionsmap[i].Ident[j]; + temps:=CreateHexString(data,True); + temps2:=dat_extensionsmap[i].Extension[3]+dat_extensionsmap[i].Extension[2]+dat_extensionsmap[i].Extension[1]+dat_extensionsmap[i].Extension[0]; + DB.ExecSQL('INSERT INTO extlist (ext,ident) VALUES ("'+temps2+'","'+temps+'");'); + progress.Position:=i; + lbl_progress.Caption:='Extensions done: '+IntToStr(i)+'/'+IntToStr(dat_header.Extensions); + Application.ProcessMessages; + IF abort THEN BEGIN + stop_convert; + Exit; + END; + END; + lbl_progress.Caption:=''; + + DoStep('Loading .dat into memory'); + Application.ProcessMessages; + + progress.Position:=0; + lbl_progress.Caption:='Files done: '+IntToStr(0)+'/'+IntToStr(dat_header.Files); + lbl_estimation.Caption:='Estimated finishing time: unknown'; + + filestream:=TFileStream.Create(dat_filename, fmOpenRead); + dat_stream:=TMemoryStream.Create; + dat_stream.CopyFrom(filestream,0); + dat_stream.Seek(0,soFromBeginning); + filestream.Free; + + progress.Max:=dat_header.Files; + begintime:=Time; + DoStep('Writing .dat-fileslist'); + Application.ProcessMessages; + + FOR i:=0 TO dat_header.Files-1 DO BEGIN + DB.ExecSQL('INSERT INTO datfiles (id,extension,name,contenttype) VALUES ('+IntToStr(i)+',"'+dat_files[i].Extension+'","'+dat_files[i].Name+'","'+IntToHex(dat_files[i].FileType,8)+'");'); + IF (dat_files[i].FileType AND $02)=0 THEN BEGIN + dat_stream.Seek(dat_files[i].DatAddr,soFromBeginning); + mem:=TMemoryStream.Create; + mem.CopyFrom(dat_stream,dat_files[i].Size); + mem.Seek(0,soFromBeginning); + DB.UpdateBlob('UPDATE datfiles SET data = ? WHERE id='+IntToStr(i)+';',mem); + HandleFile(dat_files[i].Extension,i,True); + mem.Free; + END; + IF ( (i MOD 50)=0 ) AND (i>=100) THEN + lbl_estimation.Caption:='Estimated finishing time: '+TimeToStr((Time-begintime)/i*dat_header.Files+begintime); + IF (i MOD 5)=0 THEN BEGIN + progress.Position:=i; + lbl_progress.Caption:='Files done: '+IntToStr(i)+'/'+IntToStr(dat_header.Files); + Application.ProcessMessages; + END; + IF abort THEN BEGIN + stop_convert; + Exit; + END; + END; + progress.Position:=dat_header.Files; + lbl_progress.Caption:='Files done: '+IntToStr(dat_header.Files)+'/'+IntToStr(dat_header.Files); + lbl_estimation.Caption:='FINISHED (duration: '+TimeToStr(Time-absolutebegintime)+')'; + + DoStep('FIN'); + btn_abortok.Caption:='&OK'; + btn_abortok.Default:=True; + + loaded_filename:=''; + converting:=False; + dat_stream.Free; + DB.Free; + END; + +PROCEDURE TForm10.stop_convert; + BEGIN + btn_abortok.Caption:='&Close'; + btn_abortok.Default:=True; + converting:=False; + lbl_estimation.Caption:='ABORTED'; + group_progress.Caption:='Creating DB (ABORTED)'; + IF MessageBox(Self.Handle, PChar('Delete the unfinished DB-file?'), PChar('Delete file?'), MB_YESNO)=IDYES THEN BEGIN + DB.Free; + DeleteFile(loaded_filename); + END; + END; + +PROCEDURE TForm10.btn_abortokClick(Sender: TObject); + BEGIN + IF converting THEN BEGIN + IF MessageBox(Self.Handle, PChar('Do you really want to cancel the convert-progress?'), PChar('Warning: Converting'), MB_YESNO)=IDYES THEN + abort:=True; + END ELSE BEGIN + Form10.Visible:=False; + Form1.Visible:=True; + END; + END; + + +PROCEDURE LoadFilePart(offset,size:LongWord; target:Pointer); + BEGIN + mem.Seek(offset,soFromBeginning); + mem.Read(target^,size); + END; + +PROCEDURE InsertDatLinkToDB(fileid:LongWord; offset:LongWord); + VAR + link:LongWord; + BEGIN + LoadFilePart(offset,4,@link); + IF link=0 THEN + link:=$FFFFFFFF + ELSE + link:=link DIV 256; + DB.ExecSQL('INSERT INTO linkmap (src_id,src_link_offset,target_id) VALUES ('+IntToStr(fileid)+','+IntToStr(offset)+','+IntToStr(link)+');'); + END; + +PROCEDURE InsertRawFileToDB(fileid:LongWord; src_offset,raw_addr,size:LongWord); + VAR + localmem:TMemoryStream; + BEGIN + localmem:=TMemoryStream.Create; + filestream:=TFileStream.Create(raw_filename,fmOpenRead); + filestream.Seek(raw_addr,soFromBeginning); + localmem.CopyFrom(filestream,size); + filestream.Free; + DB.ExecSQL('INSERT INTO rawmap (src_id,src_link_offset) VALUES ('+IntToStr(fileid)+','+IntToStr(src_offset)+');'); + DB.UpdateBlob('UPDATE rawmap SET data = ? WHERE src_id='+IntToStr(fileid),localmem); + localmem.Free; + END; + + + +PROCEDURE AGDB(fileid:LongWord; dir_dat2db:Boolean); + VAR + link:LongWord; + links:LongWord; + i:LongWord; + BEGIN + IF dir_dat2db THEN BEGIN + LoadFilePart($1C,4,@links); + links:=links*2; + FOR i:=0 TO links-1 DO BEGIN + LoadFilePart($20+i*4,4,@link); + InsertRawFileToDB(fileid,$20+i*4,link,1{????????????????????????????????}); + END; + END ELSE BEGIN + END; + END; +PROCEDURE AKEV(fileid:LongWord; dir_dat2db:Boolean); + VAR + i:LongWord; + BEGIN + IF dir_dat2db THEN BEGIN + FOR i:=0 TO 16 DO InsertDatLinkToDB(fileid,$8+i*4); + END ELSE BEGIN + END; + END; +PROCEDURE AKOT(fileid:LongWord; dir_dat2db:Boolean); + VAR + i:LongWord; + BEGIN + IF dir_dat2db THEN BEGIN + FOR i:=0 TO 4 DO InsertDatLinkToDB(fileid,$8+i*4); + END ELSE BEGIN + END; + END; +PROCEDURE BINA(fileid:LongWord; dir_dat2db:Boolean); + VAR + link:LongWord; + datasize:LongWord; + BEGIN + IF dir_dat2db THEN BEGIN + LoadFilePart($0C,4,@link); + LoadFilePart($08,4,@datasize); + InsertRawFileToDB(fileid,$0C,link,datasize); + END ELSE BEGIN + END; + END; +PROCEDURE CBPI(fileid:LongWord; dir_dat2db:Boolean); + VAR + i:LongWord; + BEGIN + IF dir_dat2db THEN BEGIN + FOR i:=0 TO 56 DO InsertDatLinkToDB(fileid,$8+i*4); + END ELSE BEGIN + END; + END; +PROCEDURE CBPM(fileid:LongWord; dir_dat2db:Boolean); + VAR + i:LongWord; + BEGIN + IF dir_dat2db THEN BEGIN + FOR i:=0 TO 18 DO InsertDatLinkToDB(fileid,$8+i*4); + END ELSE BEGIN + END; + END; +PROCEDURE CONS(fileid:LongWord; dir_dat2db:Boolean); + VAR + i:LongWord; + BEGIN + IF dir_dat2db THEN BEGIN + FOR i:=0 TO 1 DO InsertDatLinkToDB(fileid,$24+i*4); + END ELSE BEGIN + END; + END; +PROCEDURE CRSA(fileid:LongWord; dir_dat2db:Boolean); + VAR + packages:LongWord; + i:LongWord; + BEGIN + IF dir_dat2db THEN BEGIN + LoadFilePart($14,4,@packages); + IF packages>0 THEN + FOR i:=0 TO packages-1 DO InsertDatLinkToDB(fileid,$20+i*1100+$A0); + END ELSE BEGIN + END; + END; +PROCEDURE DOOR(fileid:LongWord; dir_dat2db:Boolean); + BEGIN + IF dir_dat2db THEN BEGIN + InsertDatLinkToDB(fileid,$08); + InsertDatLinkToDB(fileid,$10); + END ELSE BEGIN + END; + END; +PROCEDURE DPGE(fileid:LongWord; dir_dat2db:Boolean); + BEGIN + IF dir_dat2db THEN BEGIN + InsertDatLinkToDB(fileid,$40); + END ELSE BEGIN + END; + END; +PROCEDURE HPGE(fileid:LongWord; dir_dat2db:Boolean); + BEGIN + IF dir_dat2db THEN BEGIN + InsertDatLinkToDB(fileid,$0C); + END ELSE BEGIN + END; + END; +PROCEDURE IGHH(fileid:LongWord; dir_dat2db:Boolean); + BEGIN + IF dir_dat2db THEN BEGIN + InsertDatLinkToDB(fileid,$24); + InsertDatLinkToDB(fileid,$28); + END ELSE BEGIN + END; + END; +PROCEDURE IGPA(fileid:LongWord; dir_dat2db:Boolean); + VAR + links:LongWord; + i:LongWord; + BEGIN + IF dir_dat2db THEN BEGIN + LoadFilePart($1C,4,@links); + IF links>0 THEN + FOR i:=0 TO links-1 DO InsertDatLinkToDB(fileid,$20+i*4); + END ELSE BEGIN + END; + END; +PROCEDURE IGPG(fileid:LongWord; dir_dat2db:Boolean); + VAR + i:LongWord; + BEGIN + IF dir_dat2db THEN BEGIN + FOR i:=0 TO 1 DO InsertDatLinkToDB(fileid,$1C+i*4); + END ELSE BEGIN + END; + END; +PROCEDURE IGSA(fileid:LongWord; dir_dat2db:Boolean); + VAR + links:LongWord; + i:LongWord; + BEGIN + IF dir_dat2db THEN BEGIN + LoadFilePart($1C,4,@links); + IF links>0 THEN + FOR i:=0 TO links-1 DO InsertDatLinkToDB(fileid,$20+i*4); + END ELSE BEGIN + END; + END; +PROCEDURE IMPT(fileid:LongWord; dir_dat2db:Boolean); + BEGIN + IF dir_dat2db THEN BEGIN + InsertDatLinkToDB(fileid,$10); + END ELSE BEGIN + END; + END; +PROCEDURE IPGE(fileid:LongWord; dir_dat2db:Boolean); + BEGIN + IF dir_dat2db THEN BEGIN + InsertDatLinkToDB(fileid,$0C); + END ELSE BEGIN + END; + END; +PROCEDURE KEYI(fileid:LongWord; dir_dat2db:Boolean); + VAR + i:LongWord; + BEGIN + IF dir_dat2db THEN BEGIN + FOR i:=0 TO 9 DO InsertDatLinkToDB(fileid,$08+i*4); + END ELSE BEGIN + END; + END; +PROCEDURE M3GA(fileid:LongWord; dir_dat2db:Boolean); + VAR + links:LongWord; + i:LongWord; + BEGIN + IF dir_dat2db THEN BEGIN + LoadFilePart($1C,4,@links); + IF links>0 THEN + FOR i:=0 TO links-1 DO InsertDatLinkToDB(fileid,$20+i*4); + END ELSE BEGIN + END; + END; +PROCEDURE M3GM(fileid:LongWord; dir_dat2db:Boolean); + VAR + i:LongWord; + BEGIN + IF dir_dat2db THEN BEGIN + FOR i:=0 TO 6 DO InsertDatLinkToDB(fileid,$0C+i*4); + END ELSE BEGIN + END; + END; +PROCEDURE MTRL(fileid:LongWord; dir_dat2db:Boolean); + BEGIN + IF dir_dat2db THEN BEGIN + InsertDatLinkToDB(fileid,$10); + END ELSE BEGIN + END; + END; +PROCEDURE OBOA(fileid:LongWord; dir_dat2db:Boolean); + VAR + packages:Word; + i:LongWord; + BEGIN + IF dir_dat2db THEN BEGIN + LoadFilePart($1E,2,@packages); + IF packages>0 THEN + FOR i:=0 TO packages-1 DO InsertDatLinkToDB(fileid,$20+i*240); + END ELSE BEGIN + END; + END; +PROCEDURE OFGA(fileid:LongWord; dir_dat2db:Boolean); + VAR + packages:LongWord; + i:LongWord; + BEGIN + IF dir_dat2db THEN BEGIN + LoadFilePart($1C,4,@packages); + IF packages>0 THEN + FOR i:=0 TO packages-1 DO InsertDatLinkToDB(fileid,$20+i*12+$04); + END ELSE BEGIN + END; + END; +PROCEDURE ONCC(fileid:LongWord; dir_dat2db:Boolean); + VAR + i:LongWord; + BEGIN + IF dir_dat2db THEN BEGIN + END ELSE BEGIN + END; + END; +PROCEDURE ONCV(fileid:LongWord; dir_dat2db:Boolean); + BEGIN + IF dir_dat2db THEN BEGIN + InsertDatLinkToDB(fileid,$08); + END ELSE BEGIN + END; + END; +PROCEDURE ONLV(fileid:LongWord; dir_dat2db:Boolean); + VAR + i:LongWord; + BEGIN + IF dir_dat2db THEN BEGIN + FOR i:=0 TO 5 DO InsertDatLinkToDB(fileid,$48+i*4); + FOR i:=0 TO 5 DO InsertDatLinkToDB(fileid,$64+i*4); + InsertDatLinkToDB(fileid,$300); + END ELSE BEGIN + END; + END; +PROCEDURE ONOA(fileid:LongWord; dir_dat2db:Boolean); + VAR + packages:LongWord; + i:LongWord; + BEGIN + IF dir_dat2db THEN BEGIN + LoadFilePart($1C,4,@packages); + IF packages>0 THEN + FOR i:=0 TO packages-1 DO InsertDatLinkToDB(fileid,$20+i*8+$04); + END ELSE BEGIN + END; + END; +PROCEDURE ONSK(fileid:LongWord; dir_dat2db:Boolean); + BEGIN + IF dir_dat2db THEN BEGIN + InsertDatLinkToDB(fileid,$08); + InsertDatLinkToDB(fileid,$0C); + InsertDatLinkToDB(fileid,$10); + InsertDatLinkToDB(fileid,$14); + InsertDatLinkToDB(fileid,$18); + InsertDatLinkToDB(fileid,$20); + InsertDatLinkToDB(fileid,$44); + END ELSE BEGIN + END; + END; +PROCEDURE ONVL(fileid:LongWord; dir_dat2db:Boolean); + VAR + packages:LongWord; + i:LongWord; + BEGIN + IF dir_dat2db THEN BEGIN + LoadFilePart($1C,4,@packages); + IF packages>0 THEN + FOR i:=0 TO packages-1 DO InsertDatLinkToDB(fileid,$20+i*4); + END ELSE BEGIN + END; + END; +PROCEDURE ONWC(fileid:LongWord; dir_dat2db:Boolean); + BEGIN + IF dir_dat2db THEN BEGIN + InsertDatLinkToDB(fileid,$28); + InsertDatLinkToDB(fileid,$34); + InsertDatLinkToDB(fileid,$54); + InsertDatLinkToDB(fileid,$58); + InsertDatLinkToDB(fileid,$5C); + InsertDatLinkToDB(fileid,$60); + InsertDatLinkToDB(fileid,$6FC); + InsertDatLinkToDB(fileid,$700); + END ELSE BEGIN + END; + END; +PROCEDURE OPGE(fileid:LongWord; dir_dat2db:Boolean); + BEGIN + IF dir_dat2db THEN BEGIN + InsertDatLinkToDB(fileid,$1C); + END ELSE BEGIN + END; + END; +PROCEDURE OSBD(fileid:LongWord; dir_dat2db:Boolean); + VAR + link:LongWord; + datasize:LongWord; + BEGIN + IF dir_dat2db THEN BEGIN + LoadFilePart($08,4,@datasize); + LoadFilePart($0C,4,@link); + InsertRawFileToDB(fileid,$0C,link,datasize); + END ELSE BEGIN + END; + END; +PROCEDURE PSPC(fileid:LongWord; dir_dat2db:Boolean); + BEGIN + IF dir_dat2db THEN BEGIN + InsertDatLinkToDB(fileid,$50); + END ELSE BEGIN + END; + END; +PROCEDURE PSPL(fileid:LongWord; dir_dat2db:Boolean); + VAR + packages:LongWord; + i:LongWord; + BEGIN + IF dir_dat2db THEN BEGIN + LoadFilePart($1C,4,@packages); + IF packages>0 THEN + FOR i:=0 TO packages-1 DO InsertDatLinkToDB(fileid,$24+i*8); + END ELSE BEGIN + END; + END; +PROCEDURE PSUI(fileid:LongWord; dir_dat2db:Boolean); + VAR + i:LongWord; + BEGIN + IF dir_dat2db THEN BEGIN + FOR i:=0 TO 43 DO InsertDatLinkToDB(fileid,$08+i*4); + END ELSE BEGIN + END; + END; +PROCEDURE SNDD(fileid:LongWord; dir_dat2db:Boolean); + VAR + link:LongWord; + datasize:LongWord; + BEGIN + IF dir_dat2db THEN BEGIN + LoadFilePart($40,4,@datasize); + LoadFilePart($44,4,@link); + InsertRawFileToDB(fileid,$44,link,datasize); + END ELSE BEGIN + END; + END; +PROCEDURE SUBT(fileid:LongWord; dir_dat2db:Boolean); + VAR + baselink,link:LongWord; + links:LongWord; + i,j:LongWord; + data:Tdata; + BEGIN + IF dir_dat2db THEN BEGIN + LoadFilePart($18,4,@baselink); + LoadFilePart($1C,4,@links); + IF links>0 THEN BEGIN + FOR i:=0 TO links-1 DO BEGIN + LoadFilePart($20+i*4,4,@link); + SetLength(data,1024); + LoadRawFilePart(baselink+link,1024,@data[0]); + FOR j:=0 TO 1024 DO BEGIN + IF data[j]=$00 THEN Break; + END; + IF j<1024 THEN + InsertRawFileToDB(fileid,$20+i*4,baselink+link,j) + ELSE + ShowMessage('Error: Didn''t find message-end-marker...'); + END; + END; + END ELSE BEGIN + END; + END; +PROCEDURE STNA(fileid:LongWord; dir_dat2db:Boolean); + VAR + packages:Word; + i:LongWord; + BEGIN + IF dir_dat2db THEN BEGIN + LoadFilePart($1E,2,@packages); + IF packages>0 THEN + FOR i:=0 TO packages-1 DO InsertDatLinkToDB(fileid,$20+i*4); + END ELSE BEGIN + END; + END; +PROCEDURE TRAC(fileid:LongWord; dir_dat2db:Boolean); + VAR + packages:Word; + i:LongWord; + BEGIN + IF dir_dat2db THEN BEGIN + InsertDatLinkToDB(fileid,$18); + LoadFilePart($1E,2,@packages); + IF packages>0 THEN + FOR i:=0 TO packages-1 DO InsertDatLinkToDB(fileid,$20+i*12+8); + END ELSE BEGIN + END; + END; +PROCEDURE TRAM(fileid:LongWord; dir_dat2db:Boolean); + VAR + i:Byte; + link:LongWord; + BEGIN + IF dir_dat2db THEN BEGIN + FOR i:=0 TO 11 DO BEGIN + LoadFilePart($0C+i*4,4,@link); + InsertRawFileToDB(fileid,$0C+i*4,link,1{????????????????????????????????}); + END; + LoadFilePart($13C,4,@link); + InsertRawFileToDB(fileid,$13C,link,1{????????????????????????????????}); + END ELSE BEGIN + END; + END; +PROCEDURE TRAS(fileid:LongWord; dir_dat2db:Boolean); + BEGIN + IF dir_dat2db THEN BEGIN + InsertDatLinkToDB(fileid,$08); + END ELSE BEGIN + END; + END; +PROCEDURE TRBS(fileid:LongWord; dir_dat2db:Boolean); + VAR + i:LongWord; + BEGIN + IF dir_dat2db THEN BEGIN + FOR i:=0 TO 4 DO InsertDatLinkToDB(fileid,$08+i*4); + END ELSE BEGIN + END; + END; +PROCEDURE TRCM(fileid:LongWord; dir_dat2db:Boolean); + VAR + i:LongWord; + BEGIN + IF dir_dat2db THEN BEGIN + FOR i:=0 TO 2 DO InsertDatLinkToDB(fileid,$5C+i*4); + END ELSE BEGIN + END; + END; +PROCEDURE TRGA(fileid:LongWord; dir_dat2db:Boolean); + VAR + i:LongWord; + packages:Word; + BEGIN + IF dir_dat2db THEN BEGIN + LoadFilePart($1E,2,@packages); + IF packages>0 THEN + FOR i:=0 TO packages-1 DO InsertDatLinkToDB(fileid,$20+i*4); + END ELSE BEGIN + END; + END; +PROCEDURE TRGE(fileid:LongWord; dir_dat2db:Boolean); + BEGIN + IF dir_dat2db THEN BEGIN + InsertDatLinkToDB(fileid,$20); + END ELSE BEGIN + END; + END; +PROCEDURE TRIG(fileid:LongWord; dir_dat2db:Boolean); + BEGIN + IF dir_dat2db THEN BEGIN + InsertDatLinkToDB(fileid,$18); + InsertDatLinkToDB(fileid,$24); + InsertDatLinkToDB(fileid,$28); + END ELSE BEGIN + END; + END; +PROCEDURE TRMA(fileid:LongWord; dir_dat2db:Boolean); + VAR + i:LongWord; + packages:Word; + BEGIN + IF dir_dat2db THEN BEGIN + LoadFilePart($1E,2,@packages); + IF packages>0 THEN + FOR i:=0 TO packages-1 DO InsertDatLinkToDB(fileid,$20+i*4); + END ELSE BEGIN + END; + END; +PROCEDURE TRSC(fileid:LongWord; dir_dat2db:Boolean); + VAR + i:LongWord; + packages:Word; + BEGIN + IF dir_dat2db THEN BEGIN + LoadFilePart($1E,2,@packages); + IF packages>0 THEN + FOR i:=0 TO packages-1 DO InsertDatLinkToDB(fileid,$20+i*4); + END ELSE BEGIN + END; + END; +PROCEDURE TSFF(fileid:LongWord; dir_dat2db:Boolean); + VAR + i:LongWord; + packages:LongWord; + BEGIN + IF dir_dat2db THEN BEGIN + LoadFilePart($1C,4,@packages); + IF packages>0 THEN + FOR i:=0 TO packages-1 DO InsertDatLinkToDB(fileid,$20+i*4); + END ELSE BEGIN + END; + END; +PROCEDURE TSFT(fileid:LongWord; dir_dat2db:Boolean); + BEGIN + IF dir_dat2db THEN BEGIN + InsertDatLinkToDB(fileid,$1C); + END ELSE BEGIN + END; + END; +PROCEDURE TURR(fileid:LongWord; dir_dat2db:Boolean); + BEGIN + IF dir_dat2db THEN BEGIN + InsertDatLinkToDB(fileid,$60); + InsertDatLinkToDB(fileid,$6C); + InsertDatLinkToDB(fileid,$74); + END ELSE BEGIN + END; + END; +PROCEDURE TXAN(fileid:LongWord; dir_dat2db:Boolean); + VAR + i:LongWord; + packages:LongWord; + BEGIN + IF dir_dat2db THEN BEGIN + LoadFilePart($1C,4,@packages); + IF packages>0 THEN + FOR i:=0 TO packages-1 DO InsertDatLinkToDB(fileid,$20+i*4); + END ELSE BEGIN + END; + END; +PROCEDURE TXMA(fileid:LongWord; dir_dat2db:Boolean); + VAR + i:LongWord; + packages:LongWord; + BEGIN + IF dir_dat2db THEN BEGIN + LoadFilePart($1C,4,@packages); + IF packages>0 THEN + FOR i:=0 TO packages-1 DO InsertDatLinkToDB(fileid,$20+i*4); + END ELSE BEGIN + END; + END; +PROCEDURE TXMB(fileid:LongWord; dir_dat2db:Boolean); + VAR + i:LongWord; + packages:LongWord; + BEGIN + IF dir_dat2db THEN BEGIN + LoadFilePart($1C,4,@packages); + IF packages>0 THEN + FOR i:=0 TO packages-1 DO InsertDatLinkToDB(fileid,$20+i*4); + END ELSE BEGIN + END; + END; +PROCEDURE TXMP(fileid:LongWord; dir_dat2db:Boolean); + VAR + link:LongWord; + x,y:Word; + storetype:Byte; + datasize:LongWord; + BEGIN + IF dir_dat2db THEN BEGIN + LoadFilePart($8C,SizeOf(x),@x); + LoadFilePart($8E,SizeOf(y),@y); + LoadFilePart($90,SizeOf(storetype),@storetype); + LoadFilePart($9C,4,@link); + CASE storetype OF + 0,1,2: datasize:=x*y*2; + 8: datasize:=x*y*4; + 9: datasize:=x*y DIV 2; + END; + InsertRawFileToDB(fileid,$9C,link,datasize); + InsertDatLinkToDB(fileid,$94); + InsertDatLinkToDB(fileid,$98); + END ELSE BEGIN + END; + END; +PROCEDURE TXTC(fileid:LongWord; dir_dat2db:Boolean); + BEGIN + IF dir_dat2db THEN BEGIN + InsertDatLinkToDB(fileid,$08); + END ELSE BEGIN + END; + END; +PROCEDURE WMCL(fileid:LongWord; dir_dat2db:Boolean); + BEGIN + IF dir_dat2db THEN BEGIN + InsertDatLinkToDB(fileid,$24); + END ELSE BEGIN + END; + END; +PROCEDURE WMMB(fileid:LongWord; dir_dat2db:Boolean); + VAR + i:LongWord; + packages:LongWord; + BEGIN + IF dir_dat2db THEN BEGIN + LoadFilePart($1C,4,@packages); + IF packages>0 THEN + FOR i:=0 TO packages-1 DO InsertDatLinkToDB(fileid,$20+i*4); + END ELSE BEGIN + END; + END; +PROCEDURE WPGE(fileid:LongWord; dir_dat2db:Boolean); + BEGIN + IF dir_dat2db THEN BEGIN + InsertDatLinkToDB(fileid,$08); + InsertDatLinkToDB(fileid,$0C); + END ELSE BEGIN + END; + END; + +PROCEDURE InsertHandler(ext:String; needed:Boolean; handler:THandler); + BEGIN + SetLength(ConvertHandlers,Length(ConvertHandlers)+1); + ConvertHandlers[High(ConvertHandlers)].Ext:=ext; + ConvertHandlers[High(ConvertHandlers)].needed:=needed; + ConvertHandlers[High(ConvertHandlers)].handler:=handler; + END; + +BEGIN + InsertHandler('ABNA',False,NIL); +// InsertHandler('AGDB',True,AGDB); + InsertHandler('AGDB',False,NIL); + InsertHandler('AGQC',False,NIL); + InsertHandler('AGQG',False,NIL); + InsertHandler('AGQR',False,NIL); + InsertHandler('AISA',False,NIL); + InsertHandler('AITR',False,NIL); + InsertHandler('AKAA',False,NIL); + InsertHandler('AKBA',False,NIL); + InsertHandler('AKBP',False,NIL); + InsertHandler('AKDA',False,NIL); + InsertHandler('AKEV',True,AKEV); + InsertHandler('AKOT',True,AKOT); + InsertHandler('AKVA',False,NIL); + InsertHandler('BINA',True,BINA); + InsertHandler('CBPI',True,CBPI); + InsertHandler('CBPM',True,CBPM); + InsertHandler('CONS',True,CONS); + InsertHandler('CRSA',True,CRSA); + InsertHandler('DOOR',True,DOOR); + InsertHandler('DPGE',True,DPGE); + InsertHandler('ENVP',False,NIL); + InsertHandler('FILM',False,NIL); + InsertHandler('HPGE',True,HPGE); + InsertHandler('IDXA',False,NIL); + InsertHandler('IGHH',True,IGHH); + InsertHandler('IGPA',True,IGPA); + InsertHandler('IGPG',True,IGPG); + InsertHandler('IGSA',True,IGSA); + InsertHandler('IMPT',True,IMPT); + InsertHandler('IPGE',True,IPGE); + InsertHandler('KEYI',True,KEYI); + InsertHandler('M3GA',True,M3GA); + InsertHandler('M3GM',True,M3GM); + InsertHandler('MTRL',True,MTRL); + InsertHandler('OBAN',False,NIL); + InsertHandler('OBDC',False,NIL); + InsertHandler('OBOA',True,OBOA); + InsertHandler('OFGA',True,OFGA); + InsertHandler('ONCC',True,ONCC); + InsertHandler('ONCP',False,NIL); + InsertHandler('ONCV',True,ONCV); + InsertHandler('ONFA',False,NIL); + InsertHandler('ONGS',False,NIL); + InsertHandler('ONIA',False,NIL); + InsertHandler('ONLD',False,NIL); + InsertHandler('ONLV',True,ONLV); + InsertHandler('ONMA',False,NIL); + InsertHandler('ONOA',True,ONOA); + InsertHandler('ONSA',False,NIL); + InsertHandler('ONSK',True,ONSK); + InsertHandler('ONTA',False,NIL); + InsertHandler('ONVL',True,ONVL); + InsertHandler('ONWC',True,ONWC); + InsertHandler('OPGE',True,OPGE); + InsertHandler('OSBD',True,OSBD); + InsertHandler('OTIT',False,NIL); + InsertHandler('OTLF',False,NIL); + InsertHandler('PLEA',False,NIL); + InsertHandler('PNTA',False,NIL); + InsertHandler('PSPC',True,PSPC); + InsertHandler('PSPL',True,PSPL); + InsertHandler('PSUI',True,PSUI); + InsertHandler('QTNA',False,NIL); + InsertHandler('SNDD',True,SNDD); + InsertHandler('STNA',True,STNA); + InsertHandler('SUBT',True,SUBT); + InsertHandler('TRAC',True,TRAC); + InsertHandler('TRAM',True,TRAM); + InsertHandler('TRAS',True,TRAS); + InsertHandler('TRBS',True,TRBS); + InsertHandler('TRCM',True,TRCM); + InsertHandler('TRGA',True,TRGA); + InsertHandler('TRGE',True,TRGE); + InsertHandler('TRIA',False,NIL); + InsertHandler('TRIG',True,TRIG); + InsertHandler('TRMA',True,TRMA); + InsertHandler('TRSC',True,TRSC); + InsertHandler('TRTA',False,NIL); + InsertHandler('TSFF',True,TSFF); + InsertHandler('TSFL',False,NIL); + InsertHandler('TSFT',True,TSFT); + InsertHandler('TSGA',False,NIL); + InsertHandler('TSTR',False,NIL); + InsertHandler('TURR',True,TURR); + InsertHandler('TXAN',True,TXAN); + InsertHandler('TXCA',False,NIL); + InsertHandler('TXMA',True,TXMA); + InsertHandler('TXMB',True,TXMB); + InsertHandler('TXMP',True,TXMP); + InsertHandler('TXTC',True,TXTC); + InsertHandler('VCRA',False,NIL); + InsertHandler('WMCL',True,WMCL); + InsertHandler('WMDD',False,NIL); + InsertHandler('WMM_',False,NIL); + InsertHandler('WMMB',True,WMMB); + InsertHandler('WPGE',True,WPGE); +END. Index: /oup/releases/0.19a/Unit11_extractor.dfm =================================================================== --- /oup/releases/0.19a/Unit11_extractor.dfm (revision 21) +++ /oup/releases/0.19a/Unit11_extractor.dfm (revision 21) @@ -0,0 +1,210 @@ +object Form11: TForm11 + Left = 0 + Top = 0 + Width = 495 + Height = 425 + Caption = 'Extractor' + Color = clBtnFace + Font.Charset = DEFAULT_CHARSET + Font.Color = clWindowText + Font.Height = -11 + Font.Name = 'Tahoma' + Font.Style = [] + FormStyle = fsMDIChild + OldCreateOrder = False + Visible = True + WindowState = wsMaximized + OnActivate = FormActivate + OnClose = FormClose + OnCreate = FormCreate + OnResize = FormResize + PixelsPerInch = 96 + TextHeight = 13 + object group_select: TGroupBox + Left = 0 + Top = 0 + Width = 191 + Height = 398 + Align = alClient + Caption = '1. Select file(s)' + TabOrder = 0 + object panel_extension: TPanel + Left = 2 + Top = 371 + Width = 187 + Height = 25 + Align = alBottom + BevelOuter = bvNone + TabOrder = 1 + OnResize = panel_extensionResize + object combo_extension: TComboBox + Left = 2 + Top = 2 + Width = 183 + Height = 21 + Style = csDropDownList + DropDownCount = 12 + Font.Charset = DEFAULT_CHARSET + Font.Color = clWindowText + Font.Height = -11 + Font.Name = 'Tahoma' + Font.Style = [] + ItemHeight = 13 + ParentFont = False + Sorted = True + TabOrder = 0 + OnClick = combo_extensionClick + end + end + object list: TListBox + Left = 2 + Top = 15 + Width = 187 + Height = 356 + Align = alClient + ItemHeight = 13 + MultiSelect = True + TabOrder = 0 + end + end + object group_extract: TGroupBox + Left = 191 + Top = 0 + Width = 296 + Height = 398 + Align = alRight + Caption = '2. Select extract-method' + TabOrder = 1 + object group_singlefiles: TGroupBox + Left = 8 + Top = 16 + Width = 281 + Height = 185 + Caption = 'Write data into single files' + TabOrder = 0 + object btn_sel_dat: TButton + Left = 8 + Top = 16 + Width = 129 + Height = 49 + Caption = 'Selected files (dat contents only)' + TabOrder = 0 + WordWrap = True + OnClick = Extract + end + object btn_sel_datraw: TButton + Left = 8 + Top = 72 + Width = 129 + Height = 49 + Caption = 'Selected files (dat+raw)' + TabOrder = 1 + WordWrap = True + OnClick = Extract + end + object btn_sel_datraw_convert: TButton + Left = 8 + Top = 128 + Width = 129 + Height = 49 + Caption = 'Selected files (dat+raw) (with convert if possible)' + TabOrder = 2 + WordWrap = True + OnClick = Extract + end + object btn_all_dat: TButton + Left = 144 + Top = 16 + Width = 129 + Height = 49 + Caption = 'All files in list (dat contents only)' + TabOrder = 3 + WordWrap = True + OnClick = Extract + end + object btn_all_datraw: TButton + Left = 144 + Top = 72 + Width = 129 + Height = 49 + Caption = 'All files in list (dat+raw)' + TabOrder = 4 + WordWrap = True + OnClick = Extract + end + object btn_all_datraw_convert: TButton + Left = 144 + Top = 128 + Width = 129 + Height = 49 + BiDiMode = bdLeftToRight + Caption = 'All files in list (dat+raw) (with convert if possible)' + ParentBiDiMode = False + TabOrder = 5 + WordWrap = True + OnClick = Extract + end + end + object group_onefile: TGroupBox + Left = 8 + Top = 208 + Width = 281 + Height = 73 + Caption = 'Write data into one file' + TabOrder = 1 + object btn_sel_files_toone: TButton + Left = 8 + Top = 16 + Width = 129 + Height = 49 + Caption = 'Selected files (dat contents only)' + TabOrder = 0 + WordWrap = True + OnClick = Extract + end + object btn_all_files_toone: TButton + Left = 144 + Top = 16 + Width = 129 + Height = 49 + Caption = 'All files in list (dat contents only)' + TabOrder = 1 + WordWrap = True + OnClick = Extract + end + end + object group_progress: TGroupBox + Left = 8 + Top = 288 + Width = 281 + Height = 105 + Caption = 'Progress ...' + TabOrder = 2 + Visible = False + object Label1: TLabel + Left = 8 + Top = 40 + Width = 265 + Height = 17 + AutoSize = False + Caption = 'Files done: 0/0' + end + object Label2: TLabel + Left = 8 + Top = 56 + Width = 265 + Height = 17 + AutoSize = False + Caption = 'Estimated finishing time: 00:00:00' + end + object progress: TProgressBar + Left = 8 + Top = 16 + Width = 265 + Height = 17 + Smooth = True + TabOrder = 0 + end + end + end +end Index: /oup/releases/0.19a/Unit11_extractor.pas =================================================================== --- /oup/releases/0.19a/Unit11_extractor.pas (revision 21) +++ /oup/releases/0.19a/Unit11_extractor.pas (revision 21) @@ -0,0 +1,146 @@ +UNIT Unit11_extractor; +INTERFACE +USES + Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, + Dialogs, StdCtrls, ExtCtrls, StrUtils, ComCtrls; +TYPE + TForm11 = Class(TForm) + group_select: TGroupBox; + panel_extension: TPanel; + combo_extension: TComboBox; + list: TListBox; + group_extract: TGroupBox; + group_singlefiles: TGroupBox; + btn_sel_dat: TButton; + btn_sel_datraw: TButton; + btn_sel_datraw_convert: TButton; + btn_all_dat: TButton; + btn_all_datraw: TButton; + btn_all_datraw_convert: TButton; + group_onefile: TGroupBox; + btn_sel_files_toone: TButton; + btn_all_files_toone: TButton; + group_progress: TGroupBox; + progress: TProgressBar; + Label1: TLabel; + Label2: TLabel; + PROCEDURE FormCreate(Sender: TObject); + PROCEDURE FormActivate(Sender: TObject); + PROCEDURE FormClose(Sender: TObject; var Action: TCloseAction); + PROCEDURE FormResize(Sender: TObject); + PROCEDURE combo_extensionClick(Sender: TObject); + PROCEDURE panel_extensionResize(Sender: TObject); + PROCEDURE Extract(Sender: TObject); + PRIVATE + PUBLIC + PROCEDURE Recreatelist; + END; + +VAR + Form11: TForm11; + +IMPLEMENTATION +{$R *.dfm} +USES Unit1_main, Unit2_functions, Unit3_data; + +PROCEDURE TForm11.Recreatelist; + VAR + i:LongWord; + BEGIN + combo_extension.Items.Clear; + combo_extension.Items.Add('_All files_ ('+IntToStr(dat_header.Files)+')'); + FOR i:=0 TO dat_header.Extensions-1 DO BEGIN + WITH dat_extensionsmap[i] DO BEGIN + combo_extension.Items.Add( + Extension[3]+Extension[2]+Extension[1]+Extension[0]+' ('+ + IntToStr(ExtCount)+')'); + END; + END; + combo_extension.ItemIndex:=0; + combo_extensionClick(Self); + END; + +PROCEDURE TForm11.panel_extensionResize(Sender: TObject); + BEGIN + combo_extension.Width:=panel_extension.Width-5; + END; + +PROCEDURE TForm11.combo_extensionClick(Sender: TObject); + VAR + Extension:String[4]; + i:LongWord; + BEGIN + Extension:=MidStr(combo_extension.Items.Strings[combo_extension.ItemIndex],1,4); + list.Items.Clear; + IF Extension='_All' THEN BEGIN + FOR i:=0 TO dat_header.Files-1 DO + IF (dat_files[i].FileType AND $02)=0 THEN + list.Items.Add(dat_files[i].FileName); + END ELSE BEGIN + FOR i:=0 TO dat_header.Files-1 DO + IF dat_files[i].Extension=Extension THEN + IF (dat_files[i].FileType AND $02)=0 THEN + list.Items.Add(dat_files[i].FileName); + END; + END; + +PROCEDURE TForm11.FormResize(Sender: TObject); + BEGIN + IF Self.Width>=450 THEN BEGIN + END ELSE Self.Width:=450; + IF Self.Height>=400 THEN BEGIN + group_progress.Height:=group_extract.Height-293; + END ELSE Self.Height:=400; + END; + +PROCEDURE TForm11.FormClose(Sender: TObject; var Action: TCloseAction); + BEGIN + Action:=caFree; + Form1.close_window(Self.Name); + END; + +PROCEDURE TForm11.FormActivate(Sender: TObject); + BEGIN + Form1.SetActiveWindow(Self.Name); + END; + +PROCEDURE TForm11.FormCreate(Sender: TObject); + BEGIN + btn_sel_dat.Caption:= 'Selected files'+CrLf+'(dat contents only)'; + btn_sel_datraw.Caption:= 'Selected files'+CrLf+'(dat+raw contents)'; + btn_sel_datraw_convert.Caption:='Selected files'+CrLf+'(dat+raw contents)'+CrLf+'(with convert if possible)'; + btn_all_dat.Caption:= 'All files in list'+CrLf+'(dat contents only)'; + btn_all_datraw.Caption:= 'All files in list'+CrLf+'(dat+raw contents)'; + btn_all_datraw_convert.Caption:='All files in list'+CrLf+'(dat+raw contents)'+CrLf+'(with convert if possible)'; + btn_sel_files_toone.Caption:= 'Selected files'+CrLf+'(dat contents only)'; + btn_all_files_toone.Caption:= 'All files in list'+CrLf+'(dat contents only)'; + END; + +PROCEDURE TForm11.Extract(Sender: TObject); + VAR + sel_only:Boolean; + dat_only:Boolean; + convert:Boolean; + one_file:Boolean; + files:LongWord; + i:LongWord; + fs:TFileStream; + ms:TMemoryStream; + BEGIN + sel_only:=Pos('sel',TButton(Sender).Name)>0; + dat_only:=NOT (Pos('datraw',TButton(Sender).Name)>0); + convert:=Pos('convert',TButton(Sender).Name)>0; + one_file:=Pos('toone',TButton(Sender).Name)>0; + + IF sel_only THEN BEGIN + files:=list.SelCount; + FOR i:=0 TO list.Count-1 DO BEGIN + IF list.Selected[i] THEN BEGIN + BEGIN END; + END; + END; + END ELSE BEGIN + END; + END; + +END. Index: /oup/releases/0.19a/Unit1_main.dfm =================================================================== --- /oup/releases/0.19a/Unit1_main.dfm (revision 21) +++ /oup/releases/0.19a/Unit1_main.dfm (revision 21) @@ -0,0 +1,162 @@ +object Form1: TForm1 + Left = 0 + Top = 0 + HorzScrollBar.Visible = False + VertScrollBar.Visible = False + AutoScroll = False + Caption = 'Form1' + ClientHeight = 544 + ClientWidth = 692 + Color = clBtnFace + Font.Charset = DEFAULT_CHARSET + Font.Color = clWindowText + Font.Height = -11 + Font.Name = 'Tahoma' + Font.Style = [] + FormStyle = fsMDIForm + Menu = menu + OldCreateOrder = False + OnClose = FormClose + OnCreate = FormCreate + OnResize = FormResize + PixelsPerInch = 96 + TextHeight = 13 + object statbar: TStatusBar + Left = 0 + Top = 527 + Width = 692 + Height = 17 + BiDiMode = bdLeftToRight + Panels = < + item + Text = 'Nothing loaded' + Width = 500 + end + item + Text = 'Files: -' + Width = 90 + end + item + Text = 'Extensions: -' + Width = 100 + end> + ParentBiDiMode = False + end + object tabs: TTabSet + Left = 0 + Top = 507 + Width = 692 + Height = 20 + Align = alBottom + DitherBackground = False + Font.Charset = DEFAULT_CHARSET + Font.Color = clWindowText + Font.Height = -11 + Font.Name = 'Tahoma' + Font.Style = [] + SoftTop = True + Style = tsModernTabs + OnChange = tabsChange + end + object opend: TOpenDialog + Options = [ofPathMustExist, ofFileMustExist, ofEnableSizing] + Left = 480 + end + object menu: TMainMenu + AutoHotkeys = maManual + Left = 592 + object menu_main: TMenuItem + Caption = '&Main' + object menu_loaddat: TMenuItem + Caption = '&Select .dat-file ...' + ShortCut = 16463 + OnClick = menu_loaddatClick + end + object menu_lvldb: TMenuItem + Caption = 'Open OUP-Level-&DB ...' + ShortCut = 16452 + OnClick = menu_lvldbClick + end + object menu_sep1: TMenuItem + Caption = '-' + end + object menu_exit: TMenuItem + Caption = '&Exit' + OnClick = menu_exitClick + end + end + object menu_convert: TMenuItem + Caption = '&Convert' + Enabled = False + object menu_createdb: TMenuItem + Caption = 'Create level-database' + Enabled = False + OnClick = menu_createdbClick + end + object menu_createlvl: TMenuItem + Caption = 'Create level-files' + Enabled = False + OnClick = menu_createlvlClick + end + end + object menu_tools: TMenuItem + Caption = '&Tools' + Enabled = False + object menu_preview: TMenuItem + Caption = '&Preview Window ...' + ShortCut = 16464 + OnClick = menu_previewClick + end + object menu_binedit: TMenuItem + Caption = '&Binary .dat editor ...' + ShortCut = 16450 + OnClick = menu_bineditClick + end + object menu_txmpreplace: TMenuItem + Caption = '&TXMP replacer ...' + ShortCut = 16468 + OnClick = menu_txmpreplaceClick + end + object menu_extractor: TMenuItem + Caption = 'File &extractor ...' + ShortCut = 16453 + OnClick = menu_extractorClick + end + end + object menu_windows: TMenuItem + Caption = '&Windows' + object menu_windows_cascade: TMenuItem + Caption = 'Cascade' + OnClick = menu_windows_cascadeClick + end + object menu_windows_tile: TMenuItem + Caption = 'Tile' + OnClick = menu_windows_tileClick + end + object menu_windows_closeall: TMenuItem + Caption = '&Close all' + OnClick = menu_windows_closeallClick + end + object menu_sep3: TMenuItem + Caption = '-' + end + object menu_windows_next: TMenuItem + Caption = 'Next window' + ShortCut = 16417 + OnClick = menu_windows_nextClick + end + object menu_windows_previous: TMenuItem + Caption = 'Previous window' + ShortCut = 16418 + OnClick = menu_windows_previousClick + end + object menu_sep2: TMenuItem + Caption = '-' + end + end + end + object saved: TSaveDialog + Options = [ofOverwritePrompt, ofPathMustExist, ofEnableSizing] + Left = 520 + end +end Index: /oup/releases/0.19a/Unit1_main.pas =================================================================== --- /oup/releases/0.19a/Unit1_main.pas (revision 21) +++ /oup/releases/0.19a/Unit1_main.pas (revision 21) @@ -0,0 +1,425 @@ +UNIT Unit1_main; +INTERFACE +USES + Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, + Dialogs, StdCtrls, StrUtils, Clipbrd, ExtCtrls, ComCtrls, Menus, Grids, + MPHexEditor, ToolWin, ImgList, Tabs, + Unit2_functions, Unit3_data, + Unit10_leveldb, + Unit5_preview, Unit7_txmpreplace, Unit8_binedit, Unit11_extractor; + +TYPE + TForm1 = Class(TForm) + tabs: TTabSet; + saved: TSaveDialog; + opend: TOpenDialog; + statbar: TStatusBar; + menu: TMainMenu; + menu_main: TMenuItem; + menu_loaddat: TMenuItem; + menu_lvldb: TMenuItem; + menu_exit: TMenuItem; + menu_convert: TMenuItem; + menu_createdb: TMenuItem; + menu_createlvl: TMenuItem; + menu_tools: TMenuItem; + menu_preview: TMenuItem; + menu_txmpreplace: TMenuItem; + menu_binedit: TMenuItem; + menu_extractor: TMenuItem; + menu_windows: TMenuItem; + menu_windows_cascade: TMenuItem; + menu_windows_tile: TMenuItem; + menu_windows_closeall: TMenuItem; + menu_windows_next: TMenuItem; + menu_windows_previous: TMenuItem; + menu_sep1: TMenuItem; + menu_sep2: TMenuItem; + menu_sep3: TMenuItem; + PROCEDURE menu_createlvlClick(Sender: TObject); + PROCEDURE menu_extractorClick(Sender: TObject); + PROCEDURE menu_lvldbClick(Sender: TObject); + PROCEDURE menu_createdbClick(Sender: TObject); + PROCEDURE SetActiveWindow(window_name:String); + PROCEDURE tabsChange(Sender: TObject; NewTab: Integer; var AllowChange: Boolean); + PROCEDURE close_window(window_name:String); + PROCEDURE menu_windows_previousClick(Sender: TObject); + PROCEDURE menu_windows_nextClick(Sender: TObject); + PROCEDURE menu_windows_tileClick(Sender: TObject); + PROCEDURE open_child(window_context:String); + PROCEDURE menu_windows_closeallClick(Sender: TObject); + PROCEDURE menu_windows_cascadeClick(Sender: TObject); + PROCEDURE menu_window_entryClick(Sender: TObject); + PROCEDURE menu_bineditClick(Sender: TObject); + PROCEDURE menu_loaddatClick(Sender: TObject); + PROCEDURE menu_txmpreplaceClick(Sender: TObject); + PROCEDURE menu_exitClick(Sender: TObject); + PROCEDURE menu_previewClick(Sender: TObject); + PROCEDURE FormClose(Sender: TObject; var Action: TCloseAction); + PROCEDURE FormResize(Sender: TObject); + PROCEDURE FormCreate(Sender: TObject); + PRIVATE + PUBLIC + END; + +VAR + Form1: TForm1; + +IMPLEMENTATION +{$R *.dfm} +VAR + tablist:Array OF String; + +PROCEDURE TForm1.FormCreate(Sender: TObject); + BEGIN + Form1.Caption:='Oni Un/Packer '+version; + Form1.FormResize(Form1); + + IF FileExists(ExtractFilepath(Application.EXEname)+'\oniunpacker.ini') THEN BEGIN + AssignFile(AppSettingsFile,ExtractFilepath(Application.EXEname)+'\oniunpacker.ini'); + Reset(AppSettingsFile); + Read(AppSettingsFile,AppSettings); + CloseFile(AppSettingsFile); + END ELSE BEGIN + AppSettings.DatPath:='D:\Spiele\Oni\GameDataFolder'; + AppSettings.ExtractPath:='C:\Dokumente und Einstellungen\Administrator\Desktop'; + END; + END; + +PROCEDURE TForm1.FormResize(Sender: TObject); + CONST + MinWidth:Integer=750; + MinHeight:Integer=500; + BEGIN + IF Form1.Width0 THEN BEGIN + FOR i:=0 TO MDIChildCount-1 DO BEGIN + MDIChildren[i].Close; + END; + END; + tabs.Tabs.Clear; + END; +PROCEDURE TForm1.menu_windows_nextClick(Sender: TObject); + VAR i:Byte; + first_window:Byte; + current_focus:String; + BEGIN + IF MDIChildCount>1 THEN BEGIN + FOR i:=0 TO menu_windows.Count-1 DO BEGIN + IF Pos('menu_window_',menu_windows.Items[i].Name)=1 THEN BEGIN + first_window:=i; + Break; + END; + END; + current_focus:=ActiveMDIChild.Name; + FOR i:=first_window TO menu_windows.Count-1 DO + IF Pos(current_focus,menu_windows.Items[i].Name)>0 THEN + Break; + IF i=menu_windows.Count-1 THEN + menu_windows.Items[first_window].Click + ELSE + menu_windows.Items[i+1].Click; + FOR i:=0 TO High(tablist) DO BEGIN + IF tablist[i]=ActiveMDIChild.Name THEN BEGIN + tabs.TabIndex:=i; + END; + END; + END; + END; +PROCEDURE TForm1.menu_windows_previousClick(Sender: TObject); + VAR i:Byte; + first_window:Byte; + current_focus:String; + BEGIN + IF MDIChildCount>1 THEN BEGIN + FOR i:=0 TO menu_windows.Count-1 DO BEGIN + IF Pos('menu_window_',menu_windows.Items[i].Name)=1 THEN BEGIN + first_window:=i; + Break; + END; + END; + current_focus:=ActiveMDIChild.Name; + FOR i:=first_window TO menu_windows.Count-1 DO + IF Pos(current_focus,menu_windows.Items[i].Name)>0 THEN + Break; + IF i=first_window THEN + menu_windows.Items[menu_windows.Count-1].Click + ELSE + menu_windows.Items[i-1].Click; + FOR i:=0 TO High(tablist) DO BEGIN + IF tablist[i]=ActiveMDIChild.Name THEN BEGIN + tabs.TabIndex:=i; + END; + END; + END; + END; + +PROCEDURE TForm1.menu_window_entryClick(Sender: TObject); + VAR + i:Byte; + window_name:String; + BEGIN + window_name:=MidStr(TComponent(Sender).Name,Pos('window_',TComponent(Sender).Name)+7,Length(TComponent(Sender).Name)-Pos('window_',TComponent(Sender).Name)+7+1); + FOR i:=0 TO MDIChildCount-1 DO BEGIN + IF MDIChildren[i].Name=window_name THEN BEGIN + MDIChildren[i].BringToFront; + END; + END; + FOR i:=0 TO High(tablist) DO BEGIN + IF tablist[i]=ActiveMDIChild.Name THEN BEGIN + tabs.TabIndex:=i; + END; + END; + END; + + + +PROCEDURE TForm1.open_child(window_context:String); + VAR + binEdit:TForm8; + preview:TForm5; + txmpreplacer:TForm7; + extractor:TForm11; + menu_button:TMenuItem; + used:Array[1..9] OF Boolean; + i:Byte; + caption:String; + name:String; + BEGIN + FOR i:=1 TO 9 DO used[i]:=False; + IF MDIChildCount>0 THEN + FOR i:=0 TO MDIChildCount-1 DO + IF Pos(window_context,Form1.MDIChildren[i].Name)=1 THEN + used[StrToInt(RightStr(Form1.MDIChildren[i].Caption,1))]:=True; + FOR i:=1 TO 10 DO + IF i=10 THEN + Break + ELSE + IF NOT used[i] THEN Break; + + IF i<10 THEN BEGIN + name:=window_context+IntToStr(i); + IF window_context='binedit' THEN + caption:='Binary .dat-Editor '+IntToStr(i); + IF window_context='preview' THEN + caption:='Preview-Window '+IntToStr(i); + IF window_context='txmpreplace' THEN + caption:='TXMP Replacer '+IntToStr(i); + IF window_context='extractor' THEN + caption:='Extractor '+IntToStr(i); + + menu_button:=TMenuItem.Create(menu_windows); + menu_button.Caption:=caption; + menu_button.Name:='menu_window_'+name; + menu_button.OnClick:=Form1.menu_window_entryClick; + menu_windows.Add(menu_button); + + SetLength(tablist,Length(tablist)+1); + tablist[High(tablist)]:=name; + tabs.Tabs.Add(caption); + + IF window_context='binedit' THEN BEGIN + binEdit:=TForm8.Create(Application); + binEdit.Name:=name; + binEdit.Caption:=caption; + binEdit.Recreatelist; + END; + IF window_context='preview' THEN BEGIN + preview:=TForm5.Create(Application); + preview.Name:=name; + preview.Caption:=caption; + preview.Recreatelist; + END; + IF window_context='txmpreplace' THEN BEGIN + txmpreplacer:=TForm7.Create(Application); + txmpreplacer.Name:=name; + txmpreplacer.Caption:=caption; + txmpreplacer.Recreatelist; + END; + IF window_context='extractor' THEN BEGIN + extractor:=TForm11.Create(Application); + extractor.Name:=name; + extractor.Caption:=caption; + extractor.Recreatelist; + END; + + tabs.TabIndex:=High(tablist); + IF MDIChildCount=9 THEN menu_tools.Enabled:=False; + END; + END; + + +PROCEDURE TForm1.close_window(window_name:String); + VAR + i,j:Byte; + BEGIN + FOR i:=0 TO menu_windows.Count-1 DO BEGIN + IF menu_windows.Items[i].Name='menu_window_'+window_name THEN BEGIN + menu_windows.Items[i].Free; + Break; + END; + END; + FOR i:=0 TO High(tablist) DO BEGIN + IF tablist[i]=window_name THEN BEGIN + tabs.Tabs.Delete(i); + IF High(tablist)>0 THEN + FOR j:=i TO High(tablist)-1 DO + tablist[j]:=tablist[j+1]; + SetLength(tablist,Length(tablist)-1); + Break; + END; + END; + menu_tools.Enabled:=True; + END; + + +PROCEDURE TForm1.tabsChange(Sender: TObject; NewTab: Integer; var AllowChange: Boolean); + VAR + i:Byte; + BEGIN + FOR i:=0 TO MDIChildCount-1 DO BEGIN + IF MDIChildren[i].Name=tablist[NewTab] THEN + MDIChildren[i].BringToFront; + END; + END; + +PROCEDURE TForm1.SetActiveWindow(window_name:String); + VAR + i:Byte; + BEGIN + IF Length(tablist)>0 THEN + FOR i:=0 TO High(tablist) DO + IF tablist[i]=window_name THEN + tabs.TabIndex:=i; + END; + + +END. Index: /oup/releases/0.19a/Unit2_functions.pas =================================================================== --- /oup/releases/0.19a/Unit2_functions.pas (revision 21) +++ /oup/releases/0.19a/Unit2_functions.pas (revision 21) @@ -0,0 +1,328 @@ +UNIT Unit2_functions; +INTERFACE +USES Classes, Dialogs, SysUtils, StrUtils, Math, SQLiteTable3, + Unit3_data, Unit4_Exporters; + +FUNCTION GetFilesList(ext:String; pattern:String):TStringList; +FUNCTION Decode_Int(buffer:Tdata):LongWord; +FUNCTION Encode_Int(input:LongWord):Tdata; +FUNCTION Decode_Float(buffer:Tdata):Single; +FUNCTION Encode_Float(input:Single):Tdata; +FUNCTION LoadDatInfos(filename:String):Boolean; +FUNCTION LoadDatFile(fileid:LongWord):Tdata; +PROCEDURE SaveDatFile(fileid:LongWord; data:Tdata); +FUNCTION LoadDatFilePart(fileid,offset,size:LongWord; target:Pointer):Boolean; +FUNCTION LoadRawFilePart(address,size:LongWord; target:Pointer):Boolean; +FUNCTION FormatNumber(value:LongWord; width:Byte; leadingzeros:Char):String; +FUNCTION FormatFileSize(size:LongWord):String; +FUNCTION CreateHexString(data:Tdata; HexOnly:Boolean):String; +FUNCTION ExportFile(fileid:LongWord; convert:Boolean):Integer; +FUNCTION GetWinFileName(fileid:LongWord; substring:String):String; +FUNCTION GetExtractPath:String; +PROCEDURE OpenDatabase(FileName:String); + + +IMPLEMENTATION + +TYPE + TValueSwitcher=Record + CASE IsFloat: Boolean OF + True: (ValueFloat:Single); + False: (ValueInt:LongWord); + END; + + +FUNCTION Decode_Int(buffer:Tdata):LongWord; + BEGIN + Result:=buffer[0]+buffer[1]*256+buffer[2]*256*256+buffer[3]*256*256*256; + END; +FUNCTION Encode_Int(input:LongWord):Tdata; + BEGIN + Result[0]:=input MOD 256; + input:=input DIV 256; + Result[1]:=input MOD 256; + input:=input DIV 256; + Result[2]:=input MOD 256; + input:=input DIV 256; + Result[3]:=input MOD 256; + END; +FUNCTION Decode_Float(buffer:Tdata):Single; + VAR _valueswitcher:TValueSwitcher; + BEGIN + _valueswitcher.ValueInt:=Decode_Int(buffer); + Result:=_valueswitcher.ValueFloat; + END; +FUNCTION Encode_Float(input:Single):Tdata; + VAR _valueswitcher:TValueSwitcher; + BEGIN + _valueswitcher.ValueFloat:=input; + Result:=Encode_Int(_valueswitcher.ValueInt); + END; + + +FUNCTION GetFilesList(ext:String; pattern:String):TStringList; + VAR + i:LongWord; + BEGIN + SetLength(Result,0); + IF opened_state=opened_dat THEN BEGIN + FOR i:=0 TO dat_header.Files-1 DO BEGIN + IF (Length(ext)=0 OR dat_files[i].Extension=ext) AND + (Length(pattern)=0 OR Pos(pattern,dat_files[i].FileName)>0) THEN BEGIN + SetLength(Result,Length(Result)+1); + Result[High(Result)]:=dat_files[i].FileName; + END; + END; + END ELSE BEGIN + END; + END; + +FUNCTION LoadDatInfos(filename:String):Boolean; + VAR i:LongWord; + dat_file:TFileStream; + BEGIN + Result:=True; + opened_state:=opened_dat; + dat_filename:=filename; + raw_filename:=MidStr(filename,1,Length(filename)-3)+'raw'; + dat_file:=TFileStream.Create(filename, fmOpenRead); + dat_file.Read(dat_header,SizeOf(dat_header)); + FOR i:=0 TO High(dat_header.Ident) DO + IF dat_header.Ident[i]<>header_ident1[i] THEN BEGIN + Result:=False; + Exit; + END; +{ FOR i:=0 TO High(dat_header.Ident2) DO + IF dat_header.Ident2[i]<>header_ident2[i] THEN BEGIN + Result:=False; + Exit; + END; +} + SetLength(dat_filesmap,dat_header.Files); + SetLength(dat_files,dat_header.Files); + FOR i:=0 TO dat_header.Files-1 DO dat_file.Read(dat_filesmap[i],SizeOf(dat_filesmap[i])); + FOR i:=0 TO dat_header.Files-1 DO BEGIN + dat_files[i].Extension:=dat_filesmap[i].Extension; + dat_files[i].Extension:=ReverseString(dat_files[i].Extension); + dat_files[i].Size:=dat_filesmap[i].FileSize; + dat_files[i].FileType:=dat_filesmap[i].FileType; + dat_files[i].DatAddr:=dat_filesmap[i].DataAddr-8+dat_header.DataAddr; + IF (dat_filesmap[i].FileType AND $01)=0 THEN BEGIN + dat_file.Seek(dat_filesmap[i].NameAddr+dat_header.NamesAddr,soFromBeginning); + SetLength(dat_files[i].Name,100); + dat_file.Read(dat_files[i].Name[1],100); + dat_files[i].Name:=MidStr(dat_files[i].Name,1+4,Pos(#0,dat_files[i].Name)-1-4); + END ELSE BEGIN + dat_files[i].Name:=''; + END; + dat_files[i].FileName:=FormatNumber(i,5,'0')+'-'+dat_files[i].Name+'.'+dat_files[i].Extension; + END; + dat_file.Seek($40+dat_header.Files*$14,soFromBeginning); + SetLength(dat_namedfilesmap,dat_header.NamedFiles); + FOR i:=0 TO dat_header.NamedFiles-1 DO dat_file.Read(dat_namedfilesmap[i],SizeOf(dat_namedfilesmap[i])); + + dat_file.Seek($40+dat_header.Files*$14+dat_header.NamedFiles*$8,soFromBeginning); + SetLength(dat_extensionsmap,dat_header.Extensions); + FOR i:=0 TO dat_header.Extensions-1 DO dat_file.Read(dat_extensionsmap[i],SizeOf(dat_extensionsmap[i])); + + dat_file.Free; + END; + + +FUNCTION LoadDatFile(fileid:LongWord):Tdata; + VAR dat_file:TFileStream; + BEGIN + IF opened_state=opened_dat THEN BEGIN + dat_file:=TFileStream.Create(dat_filename, fmOpenRead); + dat_file.Seek(dat_files[fileid].DatAddr,soFromBeginning); + SetLength(Result,dat_files[fileid].Size); + dat_file.Read(Result[0],dat_files[fileid].Size); + dat_file.Free; + END; + END; + + +PROCEDURE SaveDatFile(fileid:LongWord; data:Tdata); + VAR dat_file:TFileStream; + BEGIN + IF opened_state=opened_dat THEN BEGIN + dat_file:=TFileStream.Create(dat_filename, fmOpenReadWrite); + dat_file.Seek(dat_files[fileid].DatAddr,soFromBeginning); + dat_file.Write(data[0],Length(data)); + dat_file.Free; + END; + END; + + +FUNCTION LoadDatFilePart(fileid,offset,size:LongWord; target:Pointer):Boolean; + VAR dat_file:TFileStream; + BEGIN + IF opened_state=opened_dat THEN BEGIN + dat_file:=TFileStream.Create(dat_filename, fmOpenRead); + Result:=True; + dat_file.Seek(dat_files[fileid].DatAddr+offset,soFromBeginning); + dat_file.Read(target^,size); + dat_file.Free; + END; + END; + + +FUNCTION LoadRawFilePart(address,size:LongWord; target:Pointer):Boolean; + VAR + filestream:TFileStream; + BEGIN + IF opened_state=opened_dat THEN BEGIN + Result:=True; + filestream:=TFileStream.Create(AnsiReplaceStr(dat_filename,'.dat','.raw'),fmOpenRead); + filestream.Seek(address,soFromBeginning); + filestream.Read(target^,size); + filestream.Free; + END; + END; + + +FUNCTION FormatNumber(value:LongWord; width:Byte; leadingzeros:Char):String; + BEGIN + Result:=AnsiReplaceStr(Format('%'+IntToStr(width)+'u',[value]),' ',leadingzeros); + END; + + +FUNCTION FormatFileSize(size:LongWord):String; + BEGIN + IF size>=1000*1024*1024 THEN BEGIN + Result:=FloatToStrF(size/1024/1024/1024,ffFixed,5,1)+' GB'; + END ELSE BEGIN + IF size>=1000*1024 THEN BEGIN + Result:=FloatToStrF(size/1024/1024,ffFixed,5,1)+' MB'; + END ELSE BEGIN + IF size>=1000 THEN BEGIN + Result:=FloatToStrF(size/1024,ffFixed,5,1)+' KB'; + END ELSE BEGIN + Result:=IntToStr(size)+' B'; + END; + END; + END; + END; + + +FUNCTION CreateHexString(data:Tdata; HexOnly:Boolean):String; + VAR + string_build,ascii_version:String; + i:LongWord; + BEGIN + string_build:=''; + ascii_version:=''; + FOR i:=0 TO High(data) DO BEGIN + IF NOT HexOnly THEN + IF (i MOD 16)=0 THEN + string_build:=string_build+'0x'+IntToHex(i,6)+' '; + string_build:=string_build+IntToHex(data[i],2); + IF NOT HexOnly THEN BEGIN + IF data[i]>=32 THEN ascii_version:=ascii_version+Chr(data[i]) + ELSE ascii_version:=ascii_version+'.'; + IF ((i+1) MOD 2)=0 THEN string_build:=string_build+#32; + IF ((i+1) MOD 16)=0 THEN BEGIN + string_build:=string_build+#32+ascii_version+CrLf; + ascii_version:=''; + END; + END; + END; + Result:=string_build; + END; + + +FUNCTION ExportFile(fileid:LongWord; convert:Boolean):Integer; + VAR + i:Byte; + BEGIN + IF opened_state=opened_dat THEN BEGIN + Result:=export_noerror; + //ExportDefFileHeader(fileid); + IF (dat_files[fileid].FileType AND $02)=0 THEN BEGIN + //ExportDatFile(fileid); + FOR i:=1 TO Length(ExportHandlers)+1 DO BEGIN + IF i<=Length(ExportHandlers) THEN BEGIN + IF ExportHandlers[i].Ext=dat_files[fileid].Extension THEN BEGIN + IF ExportHandlers[i].needed THEN BEGIN + CASE ExportHandlers[i].Handler(fileid,convert) OF + 0: Result:=0; + ELSE + Result:=export_handlererror; + END; + END; + Break; + END; + END ELSE BEGIN + Result:=export_nohandler; + END; + END; + END; + END; + END; + + +FUNCTION GetWinFileName(fileid:LongWord; substring:String):String; + VAR + name:String; + BEGIN + name:=dat_files[fileid].Name; + name:=AnsiReplaceStr(name,'\','__'); + name:=AnsiReplaceStr(name,'/','__'); + name:=AnsiReplaceStr(name,'>','__'); + name:=AnsiReplaceStr(name,'<','__'); + Result:=FormatNumber(fileid,5,'0')+'-'+name+'.'+substring+'.'+dat_files[fileid].Extension; + END; + +FUNCTION GetExtractPath:String; + BEGIN + Result:=ExtractFilePath(dat_filename)+'\extracted_'+ExtractFileName(dat_filename); + END; + + +PROCEDURE OpenDatabase(FileName:String); + VAR + i:Byte; + data:Tdata; + temps:String; + Tbl: TSQLiteTable; + BEGIN + IF NOT FileExists(FileName) THEN BEGIN + ShowMessage('File doesn''t exist!!!'); + Exit; + END; + DB:=TSQLiteDatabase.Create(FileName); + Tbl:=DB.GetTable('SELECT name,value FROM globals ORDER BY name ASC'); + REPEAT + IF Tbl.FieldAsString('name')='dbversion' THEN BEGIN + IF Tbl.FieldAsString('value')<>DBversion THEN BEGIN + ShowMessage('Database-file '+CrLf+'"'+FileName+'"'+CrLf+'has wrong version. (Required: '+DBversion+'; found: '+Tbl.FieldAsString('value')+')'); + Exit; + END; + END; + IF Tbl.FieldAsString('name')='lvl' THEN BEGIN + database_level:=StrToInt(Tbl.FieldAsString('value')); + END; + IF Tbl.FieldAsString('name')='ident' THEN BEGIN + temps:=Tbl.FieldAsString('value'); + FOR i:=0 TO High(database_ident) DO BEGIN + CASE temps[(i*2)+1+0] OF + '0'..'9': database_ident[i]:=Ord(temps[(i*2)+1+0])-48; + 'A'..'F': database_ident[i]:=Ord(temps[(i*2)+1+0])-55; + END; + database_ident[i]:=database_ident[i]*16; + CASE temps[(i*2)+1+1] OF + '0'..'9': database_ident[i]:=database_ident[i]+Ord(temps[(i*2)+1+0])-48; + 'A'..'F': database_ident[i]:=database_ident[i]+Ord(temps[(i*2)+1+0])-55; + END; + END; + END; + Tbl.Next; + UNTIL Tbl.EOF; + Tbl.Free; + opened_state:=opened_db; + END; + + + + +END. Index: /oup/releases/0.19a/Unit3_data.pas =================================================================== --- /oup/releases/0.19a/Unit3_data.pas (revision 21) +++ /oup/releases/0.19a/Unit3_data.pas (revision 21) @@ -0,0 +1,99 @@ +UNIT Unit3_data; +INTERFACE +USES Classes, SQLiteTable3; + +VAR + DB: TSQLiteDatabase; + +CONST + version:String='v0.19a'; + dbversion:String='0.1'; + CrLf:String[2]=#13+#10; + +TYPE + Tdata=Array OF Byte; + Theader=PACKED RECORD + Ident:Array[0..$13] OF Byte; + Files:LongWord; + NamedFiles:LongWord; + Extensions:LongWord; + DataAddr:LongWord; + DataSize:LongWord; + NamesAddr:LongWord; + NamesSize:LongWord; + Ident2:Array[0..$F] OF Byte; + END; + Tfilesmap=Array OF PACKED RECORD + Extension:Array[0..$3] OF Char; + DataAddr:LongWord; + NameAddr:LongWord; + FileSize:LongWord; + FileType:LongWord; + END; + Tfiles=Array OF PACKED RECORD + FileName:String; + Extension:String[4]; + Name:String; + Size:LongWord; + FileType:LongWord; + DatAddr:LongWord; + opened:Boolean; + END; + + Tnamedfilesmap=Array OF PACKED RECORD + FileNumber:LongWord; + blubb:LongWord; + END; + Textensionsmap=Array OF PACKED RECORD + Ident:Array[0..$7] OF Byte; + Extension:Array[0..$3] OF Char; + ExtCount:LongWord; + END; + + TAppSettings=RECORD + DatPath:String[250]; + ExtractPath:String[250]; + END; + + TExportHandlers=RECORD + Ext:String[4]; + needed:Boolean; + Handler:Function(fileid:LongWord; convert:Boolean):Integer; + END; + + TStringList=Array OF String; + +VAR + opened_state:Byte=0; + dat_filename:String=''; + raw_filename:String=''; + dat_header:Theader; + dat_filesmap:Tfilesmap; + dat_files:Tfiles; + dat_namedfilesmap:Tnamedfilesmap; + dat_extensionsmap:Textensionsmap; + AppSettings:TAppSettings; + AppSettingsFile:File OF TAppSettings; + + database_level:LongWord; + database_ident:Array[0..$13] OF Byte; + +CONST + header_ident1:Array[0..$13] OF Byte= + ($1F,$27,$DC,$33,$DF,$BC,$03,$00,$31,$33,$52,$56,$40,$00,$14,$00,$10,$00,$08,$00); + header_ident2:Array[0..$F] OF Byte= + ($99,$CF,$40,$00,$90,$4F,$63,$00,$F4,$55,$5F,$00,$90,$4F,$63,$00); + + export_noerror:Integer=0; + export_nohandler:Integer=1; + export_handlererror:Integer=2; + export_error:Integer=3; + + opened_nothing:Byte=0; + opened_dat:Byte=1; + opened_db:Byte=2; + +IMPLEMENTATION + +END. + Index: /oup/releases/0.19a/Unit4_Exporters.pas =================================================================== --- /oup/releases/0.19a/Unit4_Exporters.pas (revision 21) +++ /oup/releases/0.19a/Unit4_Exporters.pas (revision 21) @@ -0,0 +1,181 @@ +UNIT Unit4_Exporters; +INTERFACE +USES Classes, StrUtils, SysUtils, Math, Unit3_data, Unit6_imgfuncs; + +PROCEDURE ExportDefLine(fileid:LongWord; line:String; create:Boolean); +PROCEDURE ExportDefFileHeader(fileid:LongWord); +PROCEDURE ExportDatFile(fileid:LongWord; filename:String); + +FUNCTION ExportTRAC(fileid:LongWord; convert:Boolean):Integer; +FUNCTION ExportTXAN(fileid:LongWord; convert:Boolean):Integer; +FUNCTION ExportTXMB(fileid:LongWord; convert:Boolean):Integer; +FUNCTION ExportTXMP(fileid:LongWord; convert:Boolean):Integer; +VAR + ExportHandlers:Array[1..5] OF TExportHandlers=( + (Ext:'ABNA'; needed:False), + //(Ext:'AGDB'; needed:False), + (Ext:'TRAC'; needed:True; Handler:ExportTRAC), + (Ext:'TXAN'; needed:True; Handler:ExportTXAN), + (Ext:'TXMB'; needed:True; Handler:ExportTXMB), + (Ext:'TXMP'; needed:True; Handler:ExportTXMP) + ); + + + +IMPLEMENTATION +USES Unit2_functions; + +PROCEDURE ExportDefLine(fileid:LongWord; line:String; create:Boolean); + VAR + filestream:TFileStream; + data:Tdata; + i:LongWord; + BEGIN + SetLength(data,Length(line)+2); + FOR i:=1 TO Length(line) DO + data[i-1]:=Ord(line[i]); + data[Length(line)]:=13; + data[Length(line)+1]:=10; + { + IF create THEN + filestream:=TFileStream.Create(GetExtractPath+'\'+GetWinFileName(fileid,'_DEF_'),fmCreate) + ELSE BEGIN + filestream:=TFileStream.Create(GetExtractPath+'\'+GetWinFileName(fileid,'_DEF_'),fmOpenWrite); + filestream.Seek(0,soFromEnd); + END; + filestream.Write(data[0],Length(data)); + filestream.Free; + } + END; + +PROCEDURE ExportDefFileHeader(fileid:LongWord); + BEGIN + IF NOT DirectoryExists(GetExtractPath) THEN + CreateDir(GetExtractPath); + WITH dat_files[fileid] DO + ExportDefLine(fileid,FormatNumber(fileid,5,'0')+':'+Name+':'+Extension+':'+IntToHex(Size,8)+':'+IntToHex(FileType,8),True); + END; + +PROCEDURE ExportDatFile(fileid:LongWord; filename:String); + VAR + filestream:TFileStream; + data:Tdata; + BEGIN + data:=LoadDatFile(fileid); + filestream:=TFileStream.Create(filename,fmCreate); + filestream.Write(data[0],Length(data)); + filestream.Free; + END; + + +FUNCTION ExportTRAC; + VAR + link:LongWord; + linkcount:Word; + i:LongWord; + BEGIN + Result:=export_noerror; + + LoadDatFilePart(fileid,$18,SizeOf(link),@link); + link:=link DIV 256; + ExportDefLine(fileid,FormatNumber(0,4,'0')+':LINKtoTRAC:'+FormatNumber(link,5,'0')+':'+dat_files[link].Name+':'+dat_files[link].Extension,False); + + LoadDatFilePart(fileid,$1E,SizeOf(linkcount),@linkcount); + ExportDefLine(fileid,'TRAMLINKS:'+FormatNumber(linkcount,4,'0'),False); + FOR i:=1 TO linkcount DO BEGIN + LoadDatFilePart(fileid,$20+(i-1)*12+8,SizeOf(link),@link); + link:=link DIV 256; + ExportDefLine(fileid,FormatNumber(i,4,'0')+':LINKtoTRAM:'+FormatNumber(link,5,'0')+':'+dat_files[link].Name+':'+dat_files[link].Extension,False); + END; + END; + +FUNCTION ExportTXAN; + VAR + loop_speed,unknown:Word; + linkcount:LongWord; + link:LongWord; + i:Byte; + BEGIN + Result:=export_noerror; + + LoadDatFilePart(fileid,$14,SizeOf(loop_speed),@loop_speed); + LoadDatFilePart(fileid,$16,SizeOf(unknown),@unknown); + ExportDefLine(fileid,'LOOPSPEED:'+FormatNumber(loop_speed,2,'0'),False); + ExportDefLine(fileid,'UNKNOWN:'+FormatNumber(unknown,2,'0'),False); + + LoadDatFilePart(fileid,$1C,SizeOf(linkcount),@linkcount); + ExportDefLine(fileid,'TXMPLINKS:'+FormatNumber(linkcount,4,'0'),False); + FOR i:=0 TO linkcount-1 DO BEGIN + LoadDatFilePart(fileid,$20+i*4,SizeOf(link),@link); + link:=link DIV 256; + IF link=0 THEN link:=fileid-1; + ExportDefLine(fileid,FormatNumber(i,4,'0')+':LINKtoTXMP:'+FormatNumber(link,5,'0')+':'+dat_files[link].Name+':'+dat_files[link].Extension,False); + END; + END; + +FUNCTION ExportTXMB; + VAR + filestream:TFileStream; + subfile:Byte; + linkcount:LongWord; + link:LongWord; + width,height:Word; + cols,rows:Word; + i:Byte; + img:TImgPackage; + data:Tdata; + BEGIN + Result:=export_noerror; + subfile:=1; + + LoadDatFilePart(fileid,$10,SizeOf(width),@width); + LoadDatFilePart(fileid,$12,SizeOf(height),@height); + LoadDatFilePart(fileid,$18,SizeOf(cols),@cols); + LoadDatFilePart(fileid,$1A,SizeOf(rows),@rows); + ExportDefLine(fileid,'WIDTH:'+FormatNumber(width,4,'0'),False); + ExportDefLine(fileid,'HEIGHT:'+FormatNumber(height,4,'0'),False); + ExportDefLine(fileid,'COLS:'+FormatNumber(cols,2,'0'),False); + ExportDefLine(fileid,'ROWS:'+FormatNumber(rows,2,'0'),False); + + LoadDatFilePart(fileid,$1C,SizeOf(linkcount),@linkcount); + ExportDefLine(fileid,'TXMPLINKS:'+FormatNumber(linkcount,4,'0'),False); + FOR i:=0 TO linkcount-1 DO BEGIN + LoadDatFilePart(fileid,$20+i*4,SizeOf(link),@link); + link:=link DIV 256; + IF link=0 THEN link:=fileid-1; + ExportDefLine(fileid,FormatNumber(i,4,'0')+':LINKtoTXMP:'+FormatNumber(link,5,'0')+':'+dat_files[link].Name+':'+dat_files[link].Extension,False); + END; + + IF convert THEN BEGIN + img:=LoadTXMBconnected(fileid); + data:=ImgdataToBmp(img.imgx,img.imgy,img.imgdepth,img.storetype,img.imgdata); + filestream:=TFileStream.Create(GetExtractPath+'\'+GetWinFileName(fileid,FormatNumber(subfile,2,'0')+'-ImgData')+'.bmp',fmCreate); + filestream.Write(data[0],Length(data)); + filestream.Free; + END; + END; + +FUNCTION ExportTXMP; + VAR + filestream:TFileStream; + subfile:Byte; + img:TImgPackage; + BEGIN + Result:=export_noerror; + subfile:=1; + + img:=LoadImgData(fileid); + { + filestream:=TFileStream.Create(GetExtractPath+'\'+GetWinFileName(fileid,FormatNumber(subfile,2,'0')+'-ImgData'),fmCreate); + filestream.Write(img.imgdata[0],Length(img.imgdata)); + filestream.Free; + } + IF convert THEN BEGIN + img.imgdata:=ImgdataToBMP(img.imgx,img.imgy,img.imgdepth,img.storetype,img.imgdata); + filestream:=TFileStream.Create(GetExtractPath+'\'+GetWinFileName(fileid,FormatNumber(subfile,2,'0')+'-ImgData')+'.bmp',fmCreate); + filestream.Write(img.imgdata[0],Length(img.imgdata)); + filestream.Free; + END; + END; + +END. Index: /oup/releases/0.19a/Unit5_preview.dfm =================================================================== --- /oup/releases/0.19a/Unit5_preview.dfm (revision 21) +++ /oup/releases/0.19a/Unit5_preview.dfm (revision 21) @@ -0,0 +1,177 @@ +object Form5: TForm5 + Left = 0 + Top = 0 + Width = 319 + Height = 181 + Caption = 'Preview' + Color = clBtnFace + Font.Charset = DEFAULT_CHARSET + Font.Color = clWindowText + Font.Height = -11 + Font.Name = 'Tahoma' + Font.Style = [] + FormStyle = fsMDIChild + OldCreateOrder = False + Visible = True + WindowState = wsMaximized + OnActivate = FormActivate + OnClose = FormClose + OnCreate = FormCreate + OnResize = FormResize + PixelsPerInch = 96 + TextHeight = 13 + object Splitter1: TSplitter + Left = 150 + Top = 0 + Width = 9 + Height = 154 + AutoSnap = False + Beveled = True + MinSize = 150 + end + object panel_preview: TPanel + Left = 159 + Top = 0 + Width = 152 + Height = 154 + Align = alClient + BevelOuter = bvNone + TabOrder = 0 + object img: TImage + Left = 0 + Top = 20 + Width = 152 + Height = 134 + Align = alClient + end + object lbl_notpossible: TLabel + Left = 16 + Top = 56 + Width = 97 + Height = 65 + AutoSize = False + Caption = 'No preview possible for this filetype' + Font.Charset = DEFAULT_CHARSET + Font.Color = clWindowText + Font.Height = -16 + Font.Name = 'Tahoma' + Font.Style = [] + ParentFont = False + Visible = False + WordWrap = True + end + object panel_buttons: TPanel + Left = 0 + Top = 0 + Width = 152 + Height = 20 + Align = alTop + BevelOuter = bvNone + TabOrder = 0 + Visible = False + OnResize = panel_buttonsResize + object btn_dec: TButton + Left = 0 + Top = 0 + Width = 20 + Height = 20 + Caption = '-' + Enabled = False + TabOrder = 0 + OnClick = btn_decClick + end + object btn_startstop: TButton + Left = 21 + Top = 0 + Width = 80 + Height = 20 + Caption = 'Stop automatic' + TabOrder = 1 + OnClick = btn_startstopClick + end + object btn_inc: TButton + Left = 102 + Top = 0 + Width = 20 + Height = 20 + Caption = '+' + Enabled = False + TabOrder = 2 + OnClick = btn_incClick + end + end + end + object panel_files: TPanel + Left = 0 + Top = 0 + Width = 150 + Height = 154 + Align = alLeft + BevelOuter = bvNone + TabOrder = 1 + object list: TListBox + Left = 0 + Top = 0 + Width = 150 + Height = 129 + Align = alClient + ItemHeight = 13 + PopupMenu = popup + TabOrder = 0 + OnClick = listClick + end + object panel_extension: TPanel + Left = 0 + Top = 129 + Width = 150 + Height = 25 + Align = alBottom + BevelOuter = bvNone + TabOrder = 1 + OnResize = panel_extensionResize + object combo_extension: TComboBox + Left = 2 + Top = 2 + Width = 145 + Height = 21 + Style = csDropDownList + DropDownCount = 12 + Font.Charset = DEFAULT_CHARSET + Font.Color = clWindowText + Font.Height = -11 + Font.Name = 'Tahoma' + Font.Style = [] + ItemHeight = 13 + ParentFont = False + Sorted = True + TabOrder = 0 + OnClick = combo_extensionClick + end + end + end + object timer: TTimer + Enabled = False + OnTimer = timerTimer + Left = 144 + Top = 24 + end + object popup: TPopupMenu + AutoHotkeys = maManual + Left = 48 + Top = 56 + object popup_extractdat: TMenuItem + Caption = 'Extract .dat-file' + Enabled = False + end + object popup_extractdatraw: TMenuItem + Caption = 'Extract .dat-file and corresponding .raw-data' + Enabled = False + end + object popup_extractdatrawconvert: TMenuItem + Caption = + 'Extract .dat-file and corresponding .raw-data and convert if pos' + + 'sible' + Enabled = False + end + end +end Index: /oup/releases/0.19a/Unit5_preview.pas =================================================================== --- /oup/releases/0.19a/Unit5_preview.pas (revision 21) +++ /oup/releases/0.19a/Unit5_preview.pas (revision 21) @@ -0,0 +1,263 @@ +UNIT Unit5_preview; +INTERFACE +USES + Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, + Dialogs, Math, ExtCtrls, Unit2_functions, Unit3_data, Unit4_exporters, Unit6_imgfuncs, + StdCtrls, StrUtils, Menus; + +TYPE + TForm5 = Class(TForm) + timer: TTimer; + panel_preview: TPanel; + img: TImage; + panel_buttons: TPanel; + btn_dec: TButton; + btn_startstop: TButton; + btn_inc: TButton; + panel_files: TPanel; + list: TListBox; + panel_extension: TPanel; + combo_extension: TComboBox; + Splitter1: TSplitter; + lbl_notpossible: TLabel; + popup: TPopupMenu; + popup_extractdat: TMenuItem; + popup_extractdatraw: TMenuItem; + popup_extractdatrawconvert: TMenuItem; + procedure FormActivate(Sender: TObject); + PROCEDURE Recreatelist; + PROCEDURE listClick(Sender: TObject); + PROCEDURE PreviewTXAN; + PROCEDURE PreviewTXMB; + PROCEDURE PreviewTXMP; + PROCEDURE panel_extensionResize(Sender: TObject); + PROCEDURE combo_extensionClick(Sender: TObject); + PROCEDURE btn_incClick(Sender: TObject); + PROCEDURE btn_decClick(Sender: TObject); + PROCEDURE FormResize(Sender: TObject); + PROCEDURE btn_startstopClick(Sender: TObject); + PROCEDURE panel_buttonsResize(Sender: TObject); + PROCEDURE timerTimer(Sender: TObject); + PROCEDURE FormCreate(Sender: TObject); + PROCEDURE FormClose(Sender: TObject; var Action: TCloseAction); + PRIVATE + PUBLIC + END; + +VAR + Form5: TForm5; + +IMPLEMENTATION +{$R *.dfm} +USES Unit1_main; +VAR + memstreams:Array OF TMemoryStream; + actualimg:Byte; + _fileid:LongWord; + + +PROCEDURE TForm5.Recreatelist; + VAR + i:LongWord; + BEGIN + combo_extension.Items.Clear; + combo_extension.Items.Add('_All files_ ('+IntToStr(dat_header.Files)+')'); + FOR i:=0 TO dat_header.Extensions-1 DO BEGIN + WITH dat_extensionsmap[i] DO BEGIN + combo_extension.Items.Add( + Extension[3]+Extension[2]+Extension[1]+Extension[0]+' ('+ + IntToStr(ExtCount)+')'); + END; + END; + combo_extension.ItemIndex:=0; + combo_extensionClick(Self); + END; + + +PROCEDURE TForm5.listClick(Sender: TObject); + BEGIN + _fileid:=StrToInt(MidStr(list.Items.Strings[list.ItemIndex],1,5)); + lbl_notpossible.Visible:=False; + Self.img.Visible:=True; + Self.timer.Enabled:=False; + Self.panel_buttons.Visible:=False; + Self.Caption:='Preview '+dat_files[_fileid].FileName; + IF dat_files[_fileid].Extension='TXAN' THEN PreviewTXAN + ELSE + IF dat_files[_fileid].Extension='TXMB' THEN PreviewTXMB + ELSE + IF dat_files[_fileid].Extension='TXMP' THEN PreviewTXMP + ELSE BEGIN + Self.lbl_notpossible.Visible:=True; + Self.img.Visible:=False; + END; + END; + + +PROCEDURE TForm5.panel_extensionResize(Sender: TObject); + BEGIN + combo_extension.Width:=panel_extension.Width-5; + END; + + +PROCEDURE TForm5.combo_extensionClick(Sender: TObject); + VAR + Extension:String[4]; + i:LongWord; + BEGIN + Extension:=MidStr(combo_extension.Items.Strings[combo_extension.ItemIndex],1,4); + list.Items.Clear; + IF Extension='_All' THEN BEGIN + FOR i:=0 TO dat_header.Files-1 DO + IF (dat_files[i].FileType AND $02)=0 THEN + list.Items.Add(dat_files[i].FileName); + END ELSE BEGIN + FOR i:=0 TO dat_header.Files-1 DO + IF dat_files[i].Extension=Extension THEN + IF (dat_files[i].FileType AND $02)=0 THEN + list.Items.Add(dat_files[i].FileName); + END; + END; + + +PROCEDURE TForm5.PreviewTXMB; + VAR + data:Tdata; + img:TImgPackage; + BEGIN + SetLength(memstreams,1); + img:=LoadTXMBconnected(_fileid); + data:=ImgdataToBmp(img.imgx,img.imgy,img.imgdepth,img.storetype,img.imgdata); + + memstreams[0].Clear; + memstreams[0].Write(data[0],Length(data)); + memstreams[0].Seek(0,soFromBeginning); + + Self.img.Picture.Bitmap.LoadFromStream(memstreams[0]); + END; + +PROCEDURE TForm5.PreviewTXMP; + VAR + data:Tdata; + img:TImgPackage; + BEGIN + SetLength(memstreams,1); + img:=LoadImgData(_fileid); + data:=ImgdataToBmp(img.imgx,img.imgy,img.imgdepth,img.storetype,img.imgdata); + + memstreams[0].Clear; + memstreams[0].Write(data[0],Length(data)); + memstreams[0].Seek(0,soFromBeginning); + + Self.img.Picture.Bitmap.LoadFromStream(memstreams[0]); + END; + +PROCEDURE TForm5.PreviewTXAN; + VAR + loop_speed:Word; + linkcount:LongWord; + link:LongWord; + i:Byte; + data:Tdata; + img:TImgPackage; + BEGIN + LoadDatFilePart(_fileid,$14,SizeOf(loop_speed),@loop_speed); + LoadDatFilePart(_fileid,$1C,SizeOf(linkcount),@linkcount); + SetLength(memstreams,linkcount); + FOR i:=0 TO linkcount-1 DO BEGIN + LoadDatFilePart(_fileid,$20+i*4,SizeOf(link),@link); + link:=link DIV 256; + IF link=0 THEN link:=_fileid-1; + memstreams[i]:=TMemoryStream.Create; + img:=LoadImgData(link); + data:=ImgdataToBmp(img.imgx,img.imgy,img.imgdepth,img.storetype,img.imgdata); + memstreams[i].Clear; + memstreams[i].Write(data[0],Length(data)); + memstreams[i].Seek(0,soFromBeginning); + END; + actualimg:=254; + Self.timer.Interval:=Floor(loop_speed*(1/60)*1000); + Self.timer.Enabled:=False; + Self.btn_startstopClick(Self); + Self.panel_buttons.Visible:=True; + END; + + +PROCEDURE TForm5.FormCreate(Sender: TObject); + BEGIN + SetLength(memstreams,1); + memstreams[0]:=TMemoryStream.Create; + Self.Width:=260; + Self.Height:=300; + END; + +PROCEDURE TForm5.timerTimer(Sender: TObject); + BEGIN + Inc(actualimg); + IF actualimg>=Length(memstreams) THEN actualimg:=0; + Self.img.Picture.Bitmap.LoadFromStream(memstreams[actualimg]); + memstreams[actualimg].Seek(0,soFromBeginning); + Self.Caption:='Preview '+dat_files[_fileid].FileName+' ('+IntToStr(actualimg+1)+'/'+IntToStr(Length(memstreams))+')'; + END; + +PROCEDURE TForm5.panel_buttonsResize(Sender: TObject); + BEGIN + btn_startstop.Width:=panel_buttons.Width-45; + btn_inc.Left:=panel_buttons.Width-23; + END; + +PROCEDURE TForm5.btn_startstopClick(Sender: TObject); + BEGIN + Self.timer.Enabled:=NOT Self.timer.Enabled; + Self.btn_dec.Enabled:=NOT Self.timer.Enabled; + Self.btn_inc.Enabled:=NOT Self.timer.Enabled; + IF Self.timer.Enabled THEN + Self.btn_startstop.Caption:='Stop automatic' + ELSE + Self.btn_startstop.Caption:='Start automatic'; + END; + +PROCEDURE TForm5.FormResize(Sender: TObject); + BEGIN + IF Self.Width>=300 THEN BEGIN + END ELSE Self.Width:=300; + IF Self.Height>=200 THEN BEGIN + END ELSE Self.Height:=200; + END; + +PROCEDURE TForm5.btn_decClick(Sender: TObject); + BEGIN + IF actualimg>0 THEN + Dec(actualimg) + ELSE + actualimg:=High(memstreams); + Self.Caption:='Preview '+dat_files[_fileid].FileName+' ('+IntToStr(actualimg+1)+'/'+IntToStr(Length(memstreams))+')'; + Self.img.Picture.Bitmap.LoadFromStream(memstreams[actualimg]); + memstreams[actualimg].Seek(0,soFromBeginning); + END; + +PROCEDURE TForm5.btn_incClick(Sender: TObject); + BEGIN + IF actualimg0) THEN BEGIN + Inc(row_orig); + IF (row_orig MOD 2)=0 THEN BEGIN + Inc(row); + col:=0; + END; + END; + IF (row_orig MOD 2)=0 THEN BEGIN + IF (i MOD 2)=0 THEN BEGIN + FOR j:=0 TO (imgdepth DIV 8)-1 DO + temparray[((row*(oldx DIV 2))+col)*(imgdepth DIV 8)+j]:=data[i*2+j]; + Inc(col); + END; + END; + END; + Result:=temparray; + END; + + +FUNCTION RevertImage(imgx,imgy,imgdepth:LongWord; imgdata:Tdata):Tdata; + VAR + x,y,i:LongWord; + BEGIN + SetLength(Result,imgx*imgy*(imgdepth DIV 8)); + FOR y:=0 TO imgy-1 DO + FOR x:=0 TO imgx-1 DO + FOR i:=0 TO (imgdepth DIV 8)-1 DO + Result[((imgx*(imgy-1-y)+x)*(imgdepth DIV 8))+i]:= + imgdata[(imgx*y+x)*(imgdepth DIV 8)+i]; + END; + + +FUNCTION DecompressImage(imgx,imgy:LongWord; imgdata:Tdata):Tdata; + TYPE + Tcolor=RECORD + RGBb:Byte; + RGBg:Byte; + RGBr:Byte; + RGBa:Byte; + END; + VAR + i,j,x,y:LongWord; + color:Array[1..4] OF Tcolor; + pixel:Array[1..16] OF Byte; + BEGIN + x:=0; + y:=0; + SetLength(Result,imgx*imgy*4); + FOR i:=0 TO ((imgx*imgy) DIV 16)-1 DO BEGIN + Color[1].RGBb:=Floor(((imgdata[(i*8)+0]+imgdata[(i*8)+1]*256) AND $001F) / $001F * 255); + Color[1].RGBg:=Floor(((imgdata[(i*8)+0]+imgdata[(i*8)+1]*256) AND $07E0) / $07E0 * 255); + Color[1].RGBr:=Floor(((imgdata[(i*8)+0]+imgdata[(i*8)+1]*256) AND $F800) / $F800 * 255); + Color[1].RGBa:=255; + Color[2].RGBb:=Floor(((imgdata[(i*8)+2]+imgdata[(i*8)+3]*256) AND $001F) / $001F * 255); + Color[2].RGBg:=Floor(((imgdata[(i*8)+2]+imgdata[(i*8)+3]*256) AND $07E0) / $07E0 * 255); + Color[2].RGBr:=Floor(((imgdata[(i*8)+2]+imgdata[(i*8)+3]*256) AND $F800) / $F800 * 255); + Color[2].RGBa:=255; + Color[3].RGBb:=Floor( Color[1].RGBb/3*2 + Color[2].RGBb/3 ); + Color[3].RGBg:=Floor( Color[1].RGBg/3*2 + Color[2].RGBg/3 ); + Color[3].RGBr:=Floor( Color[1].RGBr/3*2 + Color[2].RGBr/3 ); + Color[3].RGBa:=255; + Color[4].RGBb:=Floor( Color[1].RGBb/3 + Color[2].RGBb/3*2 ); + Color[4].RGBg:=Floor( Color[1].RGBg/3 + Color[2].RGBg/3*2 ); + Color[4].RGBr:=Floor( Color[1].RGBr/3 + Color[2].RGBr/3*2 ); + Color[4].RGBa:=255; + Pixel[1]:=Floor( (imgdata[(i*8)+4] AND $C0) / $40 + 1 ); + Pixel[2]:=Floor( (imgdata[(i*8)+4] AND $30) / $10 + 1 ); + Pixel[3]:=Floor( (imgdata[(i*8)+4] AND $0C) / $04 + 1 ); + Pixel[4]:=Floor( (imgdata[(i*8)+4] AND $03) + 1 ); + Pixel[5]:=Floor( (imgdata[(i*8)+5] AND $C0) / $40 + 1 ); + Pixel[6]:=Floor( (imgdata[(i*8)+5] AND $30) / $10 + 1 ); + Pixel[7]:=Floor( (imgdata[(i*8)+5] AND $0C) / $04 + 1 ); + Pixel[8]:=Floor( (imgdata[(i*8)+5] AND $03) + 1 ); + Pixel[9]:=Floor( (imgdata[(i*8)+6] AND $C0) / $40 + 1 ); + Pixel[10]:=Floor( (imgdata[(i*8)+6] AND $30) / $10 + 1 ); + Pixel[11]:=Floor( (imgdata[(i*8)+6] AND $0C) / $04 + 1 ); + Pixel[12]:=Floor( (imgdata[(i*8)+6] AND $03) + 1 ); + Pixel[13]:=Floor( (imgdata[(i*8)+7] AND $C0) / $40 + 1 ); + Pixel[14]:=Floor( (imgdata[(i*8)+7] AND $30) / $10 + 1 ); + Pixel[15]:=Floor( (imgdata[(i*8)+7] AND $0C) / $04 + 1 ); + Pixel[16]:=Floor( (imgdata[(i*8)+7] AND $03) + 1 ); + FOR j:=0 TO 3 DO BEGIN + Result[((y+3)*imgx+x+j)*3+0]:=Color[Pixel[16-j]].RGBb; + Result[((y+3)*imgx+x+j)*3+1]:=Color[Pixel[16-j]].RGBg; + Result[((y+3)*imgx+x+j)*3+2]:=Color[Pixel[16-j]].RGBr; + END; + FOR j:=0 TO 3 DO BEGIN + Result[((y+2)*imgx+x+j)*3+0]:=Color[Pixel[12-j]].RGBb; + Result[((y+2)*imgx+x+j)*3+1]:=Color[Pixel[12-j]].RGBg; + Result[((y+2)*imgx+x+j)*3+2]:=Color[Pixel[12-j]].RGBr; + END; + FOR j:=0 TO 3 DO BEGIN + Result[((y+1)*imgx+x+j)*3+0]:=Color[Pixel[8-j]].RGBb; + Result[((y+1)*imgx+x+j)*3+1]:=Color[Pixel[8-j]].RGBg; + Result[((y+1)*imgx+x+j)*3+2]:=Color[Pixel[8-j]].RGBr; + END; + FOR j:=0 TO 3 DO BEGIN + Result[((y+0)*imgx+x+j)*3+0]:=Color[Pixel[4-j]].RGBb; + Result[((y+0)*imgx+x+j)*3+1]:=Color[Pixel[4-j]].RGBg; + Result[((y+0)*imgx+x+j)*3+2]:=Color[Pixel[4-j]].RGBr; + END; + x:=x+4; + IF x=imgx THEN BEGIN + y:=y+4; + x:=0; + END; + END; + END; + + +FUNCTION ImgdataToBmp(imgx,imgy,imgdepth,storetype:LongWord; imgdata:Tdata):Tdata; + CONST BMPheader:Array[0..53] OF Byte= + ($42,$4D,0,0,0,0,0,0,0,0,54,0,0,0, + 40,0,0,0,0,0,0,0,0,0,0,0,1,0,$18,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0); + VAR + i,x,y:LongWord; + BEGIN + CASE storetype OF + 0: BEGIN + SetLength(Result,imgx*imgy*3); + FOR y:=0 TO imgy-1 DO BEGIN + FOR x:=0 TO imgx-1 DO BEGIN + Result[((imgx*y+x)*3)+0]:=Floor( ( (imgdata[(imgx*y+x)*2]+imgdata[(imgx*y+x)*2+1]*256) AND $000F ) / $000F * 255); + Result[((imgx*y+x)*3)+1]:=Floor( ( (imgdata[(imgx*y+x)*2]+imgdata[(imgx*y+x)*2+1]*256) AND $00F0 ) / $00F0 * 255); + Result[((imgx*y+x)*3)+2]:=Floor( ( (imgdata[(imgx*y+x)*2]+imgdata[(imgx*y+x)*2+1]*256) AND $0F00 ) / $0F00 * 255); + END; + END; + END; + 1,2: BEGIN + SetLength(Result,imgx*imgy*3); + FOR y:=0 TO imgy-1 DO BEGIN + FOR x:=0 TO imgx-1 DO BEGIN + Result[((imgx*y+x)*3)+0]:=Floor( ( (imgdata[(imgx*y+x)*2]+imgdata[(imgx*y+x)*2+1]*256) AND $001F ) / $001F * 255); + Result[((imgx*y+x)*3)+1]:=Floor( ( (imgdata[(imgx*y+x)*2]+imgdata[(imgx*y+x)*2+1]*256) AND $03E0 ) / $03E0 * 255); + Result[((imgx*y+x)*3)+2]:=Floor( ( (imgdata[(imgx*y+x)*2]+imgdata[(imgx*y+x)*2+1]*256) AND $7C00 ) / $7C00 * 255); + END; + END; + END; + 8: BEGIN + SetLength(Result,imgx*imgy*3); + FOR y:=0 TO imgy-1 DO BEGIN + FOR x:=0 TO imgx-1 DO BEGIN + Result[((imgx*y+x)*3)+0]:=imgdata[(imgx*y+x)*4+0]; + Result[((imgx*y+x)*3)+1]:=imgdata[(imgx*y+x)*4+1]; + Result[((imgx*y+x)*3)+2]:=imgdata[(imgx*y+x)*4+2]; + END; + END; + END; + 9: BEGIN + Result:=DecompressImage(imgx,imgy,imgdata); + END; + END; + Result:=RevertImage(imgx,imgy,24,Result); + SetLength(Result,imgx*imgy*3+54); + FOR i:=High(Result)-54 DOWNTO 0 DO Result[i+54]:=Result[i]; + + FOR i:=0 TO High(BMPheader) DO Result[i]:=BMPheader[i]; + Result[2]:=((imgx*imgy*3+54) AND $000000FF); + Result[3]:=((imgx*imgy*3+54) AND $0000FF00) DIV $100; + Result[4]:=((imgx*imgy*3+54) AND $00FF0000) DIV $10000; + Result[5]:=((imgx*imgy*3+54) AND $FF000000) DIV $1000000; + Result[18]:=(imgx AND $000000FF) DIV $1; + Result[19]:=(imgx AND $0000FF00) DIV $100; + Result[20]:=(imgx AND $00FF0000) DIV $10000; + Result[21]:=(imgx AND $FF000000) DIV $1000000; + Result[22]:=(imgy AND $000000FF) DIV $1; + Result[23]:=(imgy AND $0000FF00) DIV $100; + Result[24]:=(imgy AND $00FF0000) DIV $10000; + Result[25]:=(imgy AND $FF000000) DIV $1000000; + Result[34]:=((imgx*imgy*3) AND $000000FF) DIV $1; + Result[35]:=((imgx*imgy*3) AND $0000FF00) DIV $100; + Result[36]:=((imgx*imgy*3) AND $00FF0000) DIV $10000; + Result[37]:=((imgx*imgy*3) AND $FF000000) DIV $1000000; + END; + +FUNCTION BmpToImgdata(bmpdata:Tdata; _32bit:Boolean):TImgPackage; + VAR + x,y:LongWord; + r24,g24,b24:Word; + r16,g16,b16:Word; + gesamt:Word; + BEGIN + Result.imgdepth:=0; + IF NOT((bmpdata[00]=$42) AND (bmpdata[01]=$4D)) THEN BEGIN + ShowMessage('Not a standard 24bit bitmap'); + Exit; + END; + IF NOT(bmpdata[10]=54) THEN BEGIN + ShowMessage('Imagedata has to start at 0x54'); + Exit; + END; + IF NOT(bmpdata[14]=40) THEN BEGIN + ShowMessage('Second bitmap header has to have 40 bytes'); + Exit; + END; + IF NOT(bmpdata[28]=24) THEN BEGIN + ShowMessage('Bitmap has to have 24bits'); + Exit; + END; + IF NOT(bmpdata[30]=0) THEN BEGIN + ShowMessage('Bitmap has to be uncompressed'); + Exit; + END; + Result.imgx:=bmpdata[18]+bmpdata[19]*256+bmpdata[20]*256*256+bmpdata[21]*256*256*256; + Result.imgy:=bmpdata[22]+bmpdata[23]*256+bmpdata[24]*256*256+bmpdata[25]*256*256*256; + IF _32bit THEN BEGIN + Result.imgdepth:=32; + Result.storetype:=8; + END ELSE BEGIN + Result.imgdepth:=16; + Result.storetype:=1; + END; + + SetLength(Result.imgdata,Result.imgx*Result.imgy*Result.imgdepth DIV 8); + IF _32bit THEN BEGIN + FOR y:=0 TO Result.imgy-1 DO BEGIN + FOR x:=0 TO Result.imgx-1 DO BEGIN + Result.imgdata[((Result.imgx*y+x)*4)+0]:=bmpdata[54+(Result.imgx*y+x)*3+0]; + Result.imgdata[((Result.imgx*y+x)*4)+1]:=bmpdata[54+(Result.imgx*y+x)*3+1]; + Result.imgdata[((Result.imgx*y+x)*4)+2]:=bmpdata[54+(Result.imgx*y+x)*3+2]; + Result.imgdata[((Result.imgx*y+x)*4)+3]:=0; + END; + END; + END ELSE BEGIN + FOR y:=0 TO Result.imgy-1 DO BEGIN + FOR x:=0 TO Result.imgx-1 DO BEGIN + r24:=bmpdata[54+(Result.imgx*y+x)*3+0]; + g24:=bmpdata[54+(Result.imgx*y+x)*3+1]; + b24:=bmpdata[54+(Result.imgx*y+x)*3+2]; + r16:=(Ceil(r24*$001F/255)) AND $001F; + g16:=(Ceil(g24*$03E0/255)) AND $03E0; + b16:=(Ceil(b24*$7C00/255)) AND $7C00; + gesamt:=r16+g16+b16; + Result.imgdata[((Result.imgx*y+x)*2)+0]:=gesamt AND $00FF; + Result.imgdata[((Result.imgx*y+x)*2)+1]:=(gesamt AND $FF00) DIV 256; + END; + END; + END; + + Result.imgdata:=RevertImage(Result.imgx,Result.imgy,Result.imgdepth,Result.imgdata); + END; + +FUNCTION LoadTXMBconnected(fileid:LongWord):TImgPackage; + VAR + i,x,y,x2,y2,pixelid,imgid:LongWord; + rows,cols:Word; + linkcount:LongWord; + link:LongWord; + single_image:TImgPackage; + images_decoded:Array OF TImgPackage; + x_start,y_start:LongWord; + BEGIN + LoadDatFilePart(fileid,$10,SizeOf(Result.imgx),@Result.imgx); + LoadDatFilePart(fileid,$12,SizeOf(Result.imgy),@Result.imgy); + LoadDatFilePart(fileid,$18,SizeOf(cols),@cols); + LoadDatFilePart(fileid,$1A,SizeOf(rows),@rows); + LoadDatFilePart(fileid,$1C,SizeOf(linkcount),@linkcount); + SetLength(images_decoded,linkcount); + FOR i:=0 TO linkcount-1 DO BEGIN + LoadDatFilePart(fileid,$20+i*4,SizeOf(link),@link); + link:=link DIV 256; + single_image:=LoadImgData(link); + images_decoded[i]:=BmpToImgdata(ImgdataToBmp(single_image.imgx,single_image.imgy,single_image.imgdepth,single_image.storetype,single_image.imgdata),False); + END; + SetLength(Result.imgdata,Result.imgx*Result.imgy*2); + FOR y:=0 TO rows-1 DO BEGIN + FOR x:=0 TO cols-1 DO BEGIN + imgid:=y*cols+x; + x_start:=0; + y_start:=0; + FOR i:=0 TO x DO IF i=400 THEN BEGIN + END ELSE Self.Width:=400; + IF Self.Height>=350 THEN BEGIN + END ELSE Self.Height:=350; + END; + +PROCEDURE TForm7.list_txmpClick(Sender: TObject); + VAR + id:LongWord; + data:Tdata; + img:TImgPackage; + mem:TMemoryStream; + fadingbyte,depthbyte,storebyte:Byte; + BEGIN + id:=StrToInt(MidStr(list_txmp.Items.Strings[list_txmp.ItemIndex],1,5)); + + LoadDatFilePart(id,$88,SizeOf(fadingbyte),@fadingbyte); + LoadDatFilePart(id,$89,SizeOf(depthbyte),@depthbyte); + LoadDatFilePart(id,$90,SizeOf(storebyte),@storebyte); + check_fading.Checked:=(fadingbyte AND $01)>0; + check_transparency.Checked:=(depthbyte AND $04)>0; + check_32bit.Checked:=(storebyte=8); + + img:=LoadImgData(id); + data:=ImgdataToBmp(img.imgx,img.imgy,img.imgdepth,img.storetype,img.imgdata); + + mem:=TMemoryStream.Create; + mem.Write(data[0],Length(data)); + mem.Seek(0,soFromBeginning); + image_txmppreview.Picture.Bitmap.LoadFromStream(mem); + mem.Free; + + group_bmpselect.Enabled:=True; + END; + +PROCEDURE TForm7.btn_loadClick(Sender: TObject); + VAR + bmpfile:TFileStream; + mem:TMemoryStream; + BEGIN + IF opend.Execute THEN BEGIN + bmpfile:=TFileStream.Create(opend.FileName, fmOpenRead); + SetLength(actual_bmpdata,bmpfile.Size); + bmpfile.Read(actual_bmpdata[0],bmpfile.Size); + bmpfile.Free; + + mem:=TMemoryStream.Create; + mem.Write(actual_bmpdata[0],Length(actual_bmpdata)); + mem.Seek(0,soFromBeginning); + image_bmppreview.Picture.Bitmap.LoadFromStream(mem); + mem.Free; + + group_options.Enabled:=True; + END; + END; + +PROCEDURE TForm7.btn_replaceClick(Sender: TObject); + VAR + id:LongWord; + imgpkg:TImgPackage; + rawfile:TFileStream; + datfile:TFileStream; + dataddr:LongWord; + old_rawaddr,new_rawaddr:LongWord; + oldwidth,oldheight:Word; + oldstore,olddepth,oldfading:Byte; + oldsize:LongWord; + newsize:LongWord; + datbyte:Word; + BEGIN + IF list_txmp.ItemIndex>=0 THEN BEGIN + imgpkg:=BmpToImgdata(actual_bmpdata,check_32bit.Checked); + datfile:=TFileStream.Create(dat_filename,fmOpenReadWrite); + + id:=StrToInt(MidStr(list_txmp.Items.Strings[list_txmp.ItemIndex],1,5)); + dataddr:=dat_files[id].dataddr; + datfile.Seek(dataddr+$8C,soFromBeginning); + datfile.Read(oldwidth,2); + datfile.Seek(dataddr+$8E,soFromBeginning); + datfile.Read(oldheight,2); + datfile.Seek(dataddr+$88,soFromBeginning); + datfile.Read(oldfading,1); + datfile.Seek(dataddr+$89,soFromBeginning); + datfile.Read(olddepth,1); + datfile.Seek(dataddr+$90,soFromBeginning); + datfile.Read(oldstore,1); + datfile.Seek(dataddr+$9C,soFromBeginning); + datfile.Read(old_rawaddr,4); + IF (oldwidth<>imgpkg.imgx) OR (oldheight<>imgpkg.imgy) THEN BEGIN + IF MessageBox(Self.Handle, + PChar('Current image and new image have different size'+CrLf+ + '(Current: '+IntToStr(oldwidth)+'x'+IntToStr(oldheight)+ + ' - New: '+IntToStr(imgpkg.imgx)+'x'+IntToStr(imgpkg.imgy)+')'+CrLf+ + 'Replace anyways?'), + PChar(list_txmp.Items.Strings[list_txmp.ItemIndex]), + MB_YESNO)=IDNO THEN Exit; + END; + + rawfile:=TFileStream.Create(raw_filename,fmOpenReadWrite); + + CASE oldstore OF + 9: oldsize:=GetImageDataSize(oldwidth,oldheight,8,(oldfading AND $01)>0); + 0,1,2: oldsize:=GetImageDataSize(oldwidth,oldheight,16,(oldfading AND $01)>0); + 8: oldsize:=GetImageDataSize(oldwidth,oldheight,32,(oldfading AND $01)>0); + ELSE + oldsize:=0; + END; + IF check_32bit.Checked THEN + newsize:=GetImageDataSize(imgpkg.imgx,imgpkg.imgy,32,check_fading.Checked) + ELSE + newsize:=GetImageDataSize(imgpkg.imgx,imgpkg.imgy,16,check_fading.Checked); + + IF newsize<=oldsize THEN + new_rawaddr:=old_rawaddr + ELSE + new_rawaddr:=rawfile.Size; + + datbyte:=$00; + IF check_fading.Checked THEN datbyte:=datbyte OR $01; + datfile.Seek(dataddr+$88,soFromBeginning); + datfile.Write(datbyte,1); + datbyte:=$10; + IF check_transparency.Checked THEN datbyte:=datbyte OR $04; + datfile.Seek(dataddr+$89,soFromBeginning); + datfile.Write(datbyte,1); + datfile.Seek(dataddr+$8C,soFromBeginning); + datfile.Write(imgpkg.imgx,2); + datfile.Seek(dataddr+$8E,soFromBeginning); + datfile.Write(imgpkg.imgy,2); + IF check_32bit.Checked THEN + datbyte:=$08 + ELSE + datbyte:=$01; + datfile.Seek(dataddr+$90,soFromBeginning); + datfile.Write(datbyte,1); + datfile.Seek(dataddr+$9C,soFromBeginning); + datfile.Write(new_rawaddr,4); + datfile.Free; + + IF check_fading.Checked THEN BEGIN + imgpkg.imgdata:=CreateFadedImage(imgpkg); + END; + + rawfile.Seek(new_rawaddr,soFromBeginning); + rawfile.Write(imgpkg.imgdata[0],Length(imgpkg.imgdata)); + rawfile.Free; + + ShowMessage('TXMP-image replaced'); + END; + END; + +PROCEDURE TForm7.FormClose(Sender: TObject; var Action: TCloseAction); + BEGIN + Action:=caFree; + Form1.close_window(Self.Name); + END; + +PROCEDURE TForm7.FormActivate(Sender: TObject); + BEGIN + Form1.SetActiveWindow(Self.Name); + END; + +PROCEDURE TForm7.btn_saveClick(Sender: TObject); + VAR + filestream:TFileStream; + img:TImgPackage; + BEGIN + IF saved.Execute THEN BEGIN + img:=LoadImgData(StrToInt(MidStr(list_txmp.Items.Strings[list_txmp.ItemIndex],1,5))); + img.imgdata:=ImgdataToBMP(img.imgx,img.imgy,img.imgdepth,img.storetype,img.imgdata); + filestream:=TFileStream.Create(saved.FileName,fmCreate); + filestream.Write(img.imgdata[0],Length(img.imgdata)); + filestream.Free; + END; + END; + +END. Index: /oup/releases/0.19a/Unit8_binedit.dfm =================================================================== --- /oup/releases/0.19a/Unit8_binedit.dfm (revision 21) +++ /oup/releases/0.19a/Unit8_binedit.dfm (revision 21) @@ -0,0 +1,207 @@ +object Form8: TForm8 + Left = 0 + Top = 0 + Width = 650 + Height = 450 + Caption = 'Binary .dat-Editor' + Color = clBtnFace + Font.Charset = DEFAULT_CHARSET + Font.Color = clWindowText + Font.Height = -11 + Font.Name = 'Tahoma' + Font.Style = [] + FormStyle = fsMDIChild + OldCreateOrder = False + Visible = True + WindowState = wsMaximized + OnActivate = FormActivate + OnClose = FormClose + OnCloseQuery = FormCloseQuery + OnCreate = FormCreate + OnResize = FormResize + PixelsPerInch = 96 + TextHeight = 13 + object Splitter1: TSplitter + Left = 150 + Top = 0 + Width = 9 + Height = 423 + AutoSnap = False + Beveled = True + MinSize = 150 + end + object panel_data: TPanel + Left = 159 + Top = 0 + Width = 483 + Height = 423 + Align = alClient + BevelOuter = bvNone + TabOrder = 0 + OnResize = panel_dataResize + object Splitter2: TSplitter + Left = 0 + Top = 300 + Width = 483 + Height = 9 + Cursor = crVSplit + Align = alTop + AutoSnap = False + Beveled = True + MinSize = 50 + end + object hex: TMPHexEditor + Left = 0 + Top = 0 + Width = 483 + Height = 300 + Cursor = crIBeam + Align = alTop + Font.Charset = DEFAULT_CHARSET + Font.Color = clWindowText + Font.Height = -16 + Font.Name = 'Courier' + Font.Style = [] + ParentFont = False + TabOrder = 0 + BytesPerRow = 16 + Translation = tkASCII + OffsetFormat = '6!10:0x|' + Colors.Background = clWindow + Colors.ChangedBackground = clWindow + Colors.ChangedText = clRed + Colors.CursorFrame = clNavy + Colors.Offset = clBlack + Colors.OddColumn = clBlue + Colors.EvenColumn = clNavy + Colors.CurrentOffsetBackground = clBtnShadow + Colors.OffsetBackGround = clBtnFace + Colors.CurrentOffset = clBtnHighlight + Colors.Grid = clBtnFace + Colors.NonFocusCursorFrame = clAqua + Colors.ActiveFieldBackground = clWindow + FocusFrame = True + AllowInsertMode = False + DrawGridLines = False + Version = 'May 23, 2005; '#169' markus stephany, vcl[at]mirkes[dot]de' + OnChange = hexChange + ShowPositionIfNotFocused = True + OnSelectionChanged = hexSelectionChanged + end + object structs: TWrapGrid + Left = 0 + Top = 309 + Width = 483 + Height = 114 + Align = alClient + DefaultColWidth = 92 + DefaultRowHeight = 18 + FixedCols = 0 + Options = [goFixedVertLine, goFixedHorzLine, goVertLine, goHorzLine, goColSizing] + TabOrder = 1 + OnClick = structsClick + end + end + object panel_files: TPanel + Left = 0 + Top = 0 + Width = 150 + Height = 423 + Align = alLeft + BevelOuter = bvNone + TabOrder = 1 + object Bevel1: TBevel + Left = 0 + Top = 359 + Width = 150 + Height = 6 + Align = alBottom + Style = bsRaised + end + object list: TListBox + Left = 0 + Top = 0 + Width = 150 + Height = 315 + Align = alClient + ItemHeight = 13 + TabOrder = 0 + OnClick = listClick + end + object panel_extension: TPanel + Left = 0 + Top = 315 + Width = 150 + Height = 44 + Align = alBottom + BevelOuter = bvNone + TabOrder = 1 + OnResize = panel_extensionResize + object lbl_filter: TLabel + Left = 2 + Top = 4 + Width = 100 + Height = 17 + AutoSize = False + Caption = '&Filter by extension:' + FocusControl = combo_extension + end + object combo_extension: TComboBox + Left = 2 + Top = 20 + Width = 145 + Height = 21 + Style = csDropDownList + DropDownCount = 12 + Font.Charset = DEFAULT_CHARSET + Font.Color = clWindowText + Font.Height = -11 + Font.Name = 'Tahoma' + Font.Style = [] + ItemHeight = 13 + ParentFont = False + Sorted = True + TabOrder = 0 + OnClick = combo_extensionClick + end + end + object panel_imexport: TPanel + Left = 0 + Top = 365 + Width = 150 + Height = 58 + Align = alBottom + BevelOuter = bvNone + TabOrder = 2 + OnResize = panel_imexportResize + object btn_export: TButton + Left = 4 + Top = 4 + Width = 142 + Height = 25 + Caption = '&Export to file...' + TabOrder = 0 + OnClick = btn_exportClick + end + object btn_import: TButton + Left = 4 + Top = 32 + Width = 142 + Height = 25 + Caption = '&Import from file...' + TabOrder = 1 + OnClick = btn_importClick + end + end + end + object opend: TOpenDialog + Options = [ofPathMustExist, ofFileMustExist, ofEnableSizing] + Left = 120 + Top = 392 + end + object saved: TSaveDialog + Options = [ofOverwritePrompt, ofPathMustExist, ofEnableSizing] + Left = 120 + Top = 368 + end +end Index: /oup/releases/0.19a/Unit8_binedit.pas =================================================================== --- /oup/releases/0.19a/Unit8_binedit.pas (revision 21) +++ /oup/releases/0.19a/Unit8_binedit.pas (revision 21) @@ -0,0 +1,413 @@ +UNIT Unit8_binedit; +INTERFACE +USES + Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, + Dialogs, Wrapgrid, StdCtrls, Grids, StrUtils, MPHexEditor, ExtCtrls, + Unit3_data, Unit2_functions, Unit9_data_structures, Unit4_exporters; + +TYPE + TForm8 = Class(TForm) + Splitter1: TSplitter; + panel_data: TPanel; + hex: TMPHexEditor; + Splitter2: TSplitter; + structs: TWrapGrid; + panel_files: TPanel; + list: TListBox; + panel_extension: TPanel; + lbl_filter: TLabel; + combo_extension: TComboBox; + Bevel1: TBevel; + panel_imexport: TPanel; + btn_export: TButton; + btn_import: TButton; + opend: TOpenDialog; + saved: TSaveDialog; +{ PROCEDURE structsGetEditText(Sender: TObject; ACol, ARow: Integer; var Value: string); + PROCEDURE structsSetEditText(Sender: TObject; ACol, ARow: Integer; const Value: string); + PROCEDURE structsKeyPress(Sender: TObject; var Key: Char); +} PROCEDURE FormActivate(Sender: TObject); + PROCEDURE btn_importClick(Sender: TObject); + PROCEDURE btn_exportClick(Sender: TObject); + PROCEDURE panel_imexportResize(Sender: TObject); + FUNCTION Save:Boolean; + PROCEDURE FormClose(Sender: TObject; var Action: TCloseAction); + PROCEDURE combo_extensionClick(Sender: TObject); + PROCEDURE panel_extensionResize(Sender: TObject); + FUNCTION GetValue(datatype:Byte; offset:LongWord):String; + PROCEDURE WriteStructureInfos(structinfoid:Integer); + PROCEDURE hexSelectionChanged(Sender: TObject); + PROCEDURE hexChange(Sender: TObject); + PROCEDURE panel_dataResize(Sender: TObject); + PROCEDURE structsClick(Sender: TObject); + PROCEDURE FormResize(Sender: TObject); + PROCEDURE ClearStructViewer; + PROCEDURE listClick(Sender: TObject); + PROCEDURE FormCloseQuery(Sender: TObject; var CanClose: Boolean); + PROCEDURE FormCreate(Sender: TObject); + PROCEDURE Recreatelist; + PRIVATE + PUBLIC + END; + +VAR + Form8: TForm8; + +IMPLEMENTATION +{$R *.dfm} +USES Unit1_main; +VAR + fileid:LongWord; + +FUNCTION IntToBin(value:Byte):String; + VAR i:Byte; + BEGIN + Result:=''; + FOR i:=7 DOWNTO 0 DO BEGIN + Result:=Result+IntToStr((value SHR i) AND $01); + END; + END; + +FUNCTION TForm8.GetValue(datatype:Byte; offset:LongWord):String; + VAR + data:Tdata; + i:Byte; + BEGIN + CASE datatype OF + 1: Result:=IntToStr(hex.data[offset]); + 2: Result:=IntToStr(hex.data[offset]+hex.data[offset+1]*256); + 3: Result:=IntToStr(hex.data[offset]+hex.data[offset+1]*256+hex.data[offset+2]*256*256); + 4: Result:=IntToStr(hex.data[offset]+hex.data[offset+1]*256+hex.data[offset+2]*256*256+hex.data[offset+3]*256*256*256); + 5: Result:='0x'+IntToHex(hex.data[offset],2); + 6: Result:='0x'+IntToHex(hex.data[offset]+hex.data[offset+1]*256,4); + 7: Result:='0x'+IntToHex(hex.data[offset]+hex.data[offset+1]*256+hex.data[offset+2]*256*256,6); + 8: Result:='0x'+IntToHex(hex.data[offset]+hex.data[offset+1]*256+hex.data[offset+2]*256*256+hex.data[offset+3]*256*256*256,8); + 9: BEGIN + SetLength(data,4); + data[0]:=hex.data[offset]; + data[1]:=hex.data[offset+1]; + data[2]:=hex.data[offset+2]; + data[3]:=hex.data[offset+3]; + Result:=FloatToStr(Decode_Float(data)); + END; + 10: Result:=IntToBin(hex.data[offset]); + 11..255: BEGIN + Result:=''; + FOR i:=1 TO datatype-10 DO BEGIN + IF hex.Data[offset+i-1]>=32 THEN + Result:=Result+Chr(hex.Data[offset+i-1]) + ELSE + Result:=Result+'.'; + END; + END; + END; + END; + +PROCEDURE TForm8.WriteStructureInfos(structinfoid:Integer); + VAR + i:Byte; + BEGIN + IF structinfoid>=0 THEN BEGIN + structs.Enabled:=True; + WITH structure_infos[structinfoid] DO BEGIN + Self.structs.RowCount:=Length(entries)+1; + FOR i:=1 TO Length(entries) DO BEGIN + Self.structs.Cells[0,i]:=entries[i-1].name; + Self.structs.Cells[1,i]:='0x'+IntToHex(entries[i-1].offset,6); + Self.structs.Cells[2,i]:=GetDataType(entries[i-1].datatype); + Self.structs.Cells[3,i]:=GetValue(entries[i-1].datatype,entries[i-1].offset); + Self.structs.Cells[4,i]:=entries[i-1].description; + END; + END; + END; + END; + +PROCEDURE TForm8.Recreatelist; + VAR + i:LongWord; + BEGIN + combo_extension.Items.Clear; + combo_extension.Items.Add('_All files_ ('+IntToStr(dat_header.Files)+')'); + FOR i:=0 TO dat_header.Extensions-1 DO BEGIN + WITH dat_extensionsmap[i] DO BEGIN + combo_extension.Items.Add( + Extension[3]+Extension[2]+Extension[1]+Extension[0]+' ('+ + IntToStr(ExtCount)+')'); + END; + END; + combo_extension.ItemIndex:=0; + combo_extensionClick(Self); + END; + +PROCEDURE TForm8.FormCreate(Sender: TObject); + BEGIN + Self.Caption:=''; + fileid:=0; + structs.ColCount:=5; + structs.RowCount:=2; + structs.FixedRows:=1; + structs.Cells[0,0]:='Name'; + structs.Cells[1,0]:='Offset'; + structs.Cells[2,0]:='Type'; + structs.Cells[3,0]:='Value'; + structs.Cells[4,0]:='Description'; + structs.ColWidths[0]:=75; + structs.ColWidths[1]:=60; + structs.ColWidths[2]:=75; + structs.ColWidths[3]:=75; + Self.panel_dataResize(Self); + END; + +FUNCTION TForm8.Save:Boolean; + VAR + mem:TMemoryStream; + data:Tdata; + BEGIN + CASE MessageBox(Self.Handle,PChar('Save changes to file '+dat_files[fileid].FileName+'?'),PChar('Data changed...'),MB_YESNOCANCEL) OF + IDYES: BEGIN + mem:=TMemoryStream.Create; + hex.SaveToStream(mem); + mem.Seek(0,soFromBeginning); + SetLength(data,mem.Size); + mem.Read(data[0],mem.Size); + mem.Free; + SaveDatFile(fileid,data); + Result:=True; + END; + IDNO: Result:=True; + IDCANCEL: BEGIN + Result:=False; + END; + END; + END; + +PROCEDURE TForm8.FormCloseQuery(Sender: TObject; var CanClose: Boolean); + BEGIN + IF hex.Modified THEN BEGIN + IF NOT Save THEN CanClose:=False; + END; + END; + +PROCEDURE TForm8.listClick(Sender: TObject); + VAR + mem:TMemoryStream; + data:Tdata; + i:LongWord; + BEGIN + IF hex.Modified THEN BEGIN + IF NOT Save THEN BEGIN + FOR i:=0 TO list.Count-1 DO BEGIN + IF StrToInt(MidStr(list.Items.Strings[i],1,5))=fileid THEN BEGIN + list.ItemIndex:=i; + Exit; + END; + END; + END; + END; + Self.ClearStructViewer; + fileid:=StrToInt(MidStr(list.Items.Strings[list.ItemIndex],1,5)); + data:=LoadDatFile(fileid); + mem:=TMemoryStream.Create; + mem.Write(data[0],Length(data)); + hex.LoadFromStream(mem); + mem.Free; + WriteStructureInfos(GetStructureInfoId(dat_files[fileid].Extension)); + END; + +PROCEDURE TForm8.ClearStructViewer; + VAR + x:Word; + BEGIN + structs.RowCount:=2; + FOR x:=0 TO structs.ColCount-1 DO structs.Cells[x,1]:=''; + structs.Enabled:=False; + END; + +PROCEDURE TForm8.FormResize(Sender: TObject); + BEGIN + IF Self.Width>=650 THEN BEGIN + END ELSE Self.Width:=650; + IF Self.Height>=450 THEN BEGIN + END ELSE Self.Height:=450; + END; + +PROCEDURE TForm8.structsClick(Sender: TObject); + VAR + offset:LongWord; + length:Byte; + BEGIN + IF structs.Row>0 THEN BEGIN + offset:=structure_infos[GetStructureInfoId(dat_files[fileid].extension)].entries[structs.Row-1].offset; + length:=GetTypeDataLength(structure_infos[GetStructureInfoId(dat_files[fileid].extension)].entries[structs.Row-1].datatype); + hex.SelStart:=offset; + hex.SelEnd:=offset+length-1; +{ IF structs.Cells[structs.Col,0]='Value' THEN + IF structure_infos[GetStructureInfoId(dat_files[fileid].Extension)].entries[structs.Row-1].datatype<=10 THEN + structs.Options:=structs.Options+[goEditing] + ELSE + structs.Options:=structs.Options-[goEditing]; +} END; + END; + +PROCEDURE TForm8.panel_dataResize(Sender: TObject); + BEGIN + structs.ColWidths[4]:=structs.Width-structs.ColWidths[0]-structs.ColWidths[1]-structs.ColWidths[2]-structs.ColWidths[3]-28; + END; + +PROCEDURE TForm8.hexChange(Sender: TObject); + BEGIN + IF hex.DataSize>0 THEN + WriteStructureInfos(GetStructureInfoId(dat_files[fileid].Extension)); + END; + +PROCEDURE TForm8.hexSelectionChanged(Sender: TObject); + VAR + selstart:Integer; + i,j:Word; + BEGIN + FOR i:=1 TO structs.RowCount-1 DO BEGIN + FOR j:=0 TO structs.ColCount-1 DO BEGIN + structs.CellColors[j,i]:=clWhite; + structs.CellFontColors[j,i]:=clBlack; + END; + END; + IF hex.DataSize>0 THEN BEGIN + selstart:=hex.SelStart; + IF GetStructureInfoId(dat_files[fileid].Extension)>=0 THEN BEGIN + WITH structure_infos[GetStructureInfoId(dat_files[fileid].Extension)] DO BEGIN + FOR i:=0 TO High(entries) DO BEGIN + IF ((selstart-entries[i].offset)=0) THEN BEGIN + FOR j:=0 TO structs.ColCount-1 DO BEGIN + structs.CellColors[j,i+1]:=clBlue; + structs.CellFontColors[j,i+1]:=clWhite; + END; + structs.Row:=i+1; + END; + END; + END; + END; + END; + END; + +PROCEDURE TForm8.panel_extensionResize(Sender: TObject); + BEGIN + combo_extension.Width:=panel_extension.Width-5; + END; + +PROCEDURE TForm8.combo_extensionClick(Sender: TObject); + VAR + Extension:String[4]; + i:LongWord; + BEGIN + Extension:=MidStr(combo_extension.Items.Strings[combo_extension.ItemIndex],1,4); + list.Items.Clear; + IF Extension='_All' THEN BEGIN + FOR i:=0 TO dat_header.Files-1 DO + IF (dat_files[i].FileType AND $02)=0 THEN + list.Items.Add(dat_files[i].FileName); + END ELSE BEGIN + FOR i:=0 TO dat_header.Files-1 DO + IF dat_files[i].Extension=Extension THEN + IF (dat_files[i].FileType AND $02)=0 THEN + list.Items.Add(dat_files[i].FileName); + END; + IF list.Count>0 THEN BEGIN + list.ItemIndex:=0; + listClick(Self); + END; + END; + +PROCEDURE TForm8.FormClose(Sender: TObject; var Action: TCloseAction); + BEGIN + Action:=caFree; + Form1.close_window(Self.Name); + END; + +PROCEDURE TForm8.panel_imexportResize(Sender: TObject); + BEGIN + btn_import.Width:=panel_imexport.Width-8; + btn_export.Width:=panel_imexport.Width-8; + END; + +PROCEDURE TForm8.btn_exportClick(Sender: TObject); + BEGIN + saved.Filter:='Files of matching extension (*.'+dat_files[fileid].Extension+')|*.'+dat_files[fileid].Extension+'|All files|*.*'; + saved.DefaultExt:=dat_files[fileid].Extension; + IF saved.Execute THEN BEGIN + ExportDatFile(fileid,saved.FileName); + END; + END; + +PROCEDURE TForm8.btn_importClick(Sender: TObject); + VAR + data:Tdata; + fs:TFileStream; + BEGIN + opend.Filter:='Files of matching extension (*.'+dat_files[fileid].Extension+')|*.'+dat_files[fileid].Extension+'|All files|*.*'; + IF opend.Execute THEN BEGIN + fs:=TFileStream.Create(opend.FileName,fmOpenRead); + IF fs.Size<>dat_files[fileid].size THEN BEGIN + ShowMessage('Can''t import '+ExtractFilename(opend.FileName)+ + ', file has to have same size as file in .dat.'+CrLf+ + 'Size of file in .dat: '+FormatFileSize(dat_files[fileid].size)+CrLf+ + 'Size of chosen file: '+FormatFileSize(fs.Size)); + END ELSE BEGIN + SetLength(data,fs.Size); + fs.Read(data[0],fs.Size); + fs.Free; + fs:=TFileStream.Create(dat_filename,fmOpenReadWrite); + fs.Seek(dat_files[fileid].dataddr,soFromBeginning); + fs.Write(data[0],Length(data)); + END; + fs.Free; + listClick(Self); + END; + END; + +PROCEDURE TForm8.FormActivate(Sender: TObject); + BEGIN + Form1.SetActiveWindow(Self.Name); + END; +{ +PROCEDURE TForm8.structsKeyPress(Sender: TObject; VAR Key: Char); + VAR + dt:Byte; + BEGIN + IF structs.EditorMode THEN BEGIN + dt:=structure_infos[GetStructureInfoId(dat_files[fileid].Extension)].entries[structs.Row-1].datatype; + CASE dt OF + 1..4: BEGIN + IF NOT (Key IN [#8,#13,#27,'0'..'9']) THEN Key:=#0; + END; + 5..8: BEGIN + IF NOT (Key IN [#8,#13,#27,'0'..'9','A'..'F','a'..'f']) THEN Key:=#0; + IF Key IN ['a'..'f'] THEN Key:=UpCase(Key); + IF NOT (Key IN [#8,#13,#27]) AND ( Length(structs.Cells[structs.Col,structs.Row])>=2*(dt-4) ) THEN Key:=#0; + END; + 9: BEGIN + IF (Key IN ['.']) AND (Pos('.',structs.Cells[structs.Col,structs.Row])>0) THEN Key:=#0; + IF NOT (Key IN [#8,#13,#27,'0'..'9','.','-']) THEN Key:=#0; + END; + 10: BEGIN + IF NOT (Key IN [#8,#13,#27,'0'..'1']) THEN Key:=#0; + IF NOT (Key IN [#8,#13,#27]) AND ( Length(structs.Cells[structs.Col,structs.Row])>=8 ) THEN Key:=#0; + END; + END; + END; + END; + +PROCEDURE TForm8.structsSetEditText(Sender: TObject; ACol, ARow: Integer; CONST Value: string); + BEGIN + IF NOT TWrapGrid(Sender).EditorMode THEN + ShowMessage('['+IntToStr(ACol)+'|'+IntToStr(ARow)+']='+Value); + END; + +PROCEDURE TForm8.structsGetEditText(Sender: TObject; ACol, ARow: Integer; var Value: string); + BEGIN + IF structs.EditorMode THEN + ShowMessage('EditorMode - '+Value) + ELSE + ShowMessage('NOT EditorMode - '+Value); + END; +} +END. Index: /oup/releases/0.19a/Unit9_data_structures.pas =================================================================== --- /oup/releases/0.19a/Unit9_data_structures.pas (revision 21) +++ /oup/releases/0.19a/Unit9_data_structures.pas (revision 21) @@ -0,0 +1,113 @@ +UNIT Unit9_data_structures; +INTERFACE +USES SysUtils; + +TYPE + Tstructure_entry=RECORD + name:String; + offset:LongWord; + datatype:Byte; // 1..4: Integer[1..4] dec; 5..8: Integer[1..4] hex; 9: float; 10: bitset; 11+: string[1+] + description:String; + END; + Tstructure_info=RECORD + extension:String; + typedesc:String; + entries:Array OF Tstructure_entry; + END; + Tstructures=Array OF Tstructure_info; + +VAR + structure_infos:Tstructures; + + +FUNCTION GetDataType(typeid:Byte):String; +FUNCTION GetStructureInfoId(ext:String):Integer; +FUNCTION GetTypeDataLength(datatype:Byte):Byte; + + + +IMPLEMENTATION + +FUNCTION GetTypeDataLength(datatype:Byte):Byte; + BEGIN + CASE datatype OF + 1..4: Result:=datatype; + 5..8: Result:=datatype-4; + 9: Result:=4; + 10: Result:=1; + 11..255: Result:=datatype-10; + END; + END; + + +FUNCTION GetStructureInfoId(ext:String):Integer; + VAR + i:Integer; + BEGIN + FOR i:=0 TO High(structure_infos) DO BEGIN + IF structure_infos[i].extension=ext THEN BEGIN + Result:=i; + Exit; + END; + END; + Result:=-1; + END; + + +FUNCTION GetDataType(typeid:Byte):String; + BEGIN + CASE typeid OF + 1..4: Result:='Int'+IntToStr(typeid*8); + 5..8: Result:='Int'+IntToStr((typeid-4)*8); + 9: Result:='Float'; + 10: Result:='BitSet'; + 11..255: Result:='String('+IntToStr(typeid-10)+')'; + END; + END; + + +PROCEDURE AddEntry(_ext:String; _name:String; _offset:LongWord; _datatype:Byte; _description:String); + VAR + sid:Integer; + BEGIN + sid:=GetStructureInfoId(_ext); + IF sid>=0 THEN BEGIN + WITH structure_infos[sid] DO BEGIN + SetLength(entries,Length(entries)+1); + WITH entries[High(entries)] DO BEGIN + name:=_name; + offset:=_offset; + datatype:=_datatype; + description:=_description; + END; + END; + END; + END; + + +PROCEDURE AddExtension(_ext:String; _typedesc:String); + BEGIN + IF GetStructureInfoId(_ext)<0 THEN BEGIN + SetLength(structure_infos,Length(structure_infos)+1); + WITH structure_infos[High(structure_infos)] DO BEGIN + extension:='TXMP'; + typedesc:='Texture'; + END; + END; + END; + + +BEGIN + AddExtension('TXMP','Texture'); + AddEntry('TXMP','ID',$00,4,'ID of this file'); + AddEntry('TXMP','LevelID',$04,8,'ID of the level this file is in'); + AddEntry('TXMP','FileName',$08,138,''); + AddEntry('TXMP','Fading',$88,10,'Fading-Bitset'); + AddEntry('TXMP','Depth',$89,10,'Depth-Bitset'); + AddEntry('TXMP','Width',$8C,2,'x-resolution of image'); + AddEntry('TXMP','Height',$8E,2,'y-resolution of image'); + AddEntry('TXMP','Storetype',$90,10,'Storetype-Bitset'); + AddEntry('TXMP','TXAN-Link',$94,8,'Link to the TXAN-file (if this TXMP is the first image of an animation)'); + AddEntry('TXMP','TXMP-Link',$98,8,'Link to another TXMP-file'); + AddEntry('TXMP','Raw-Link',$9C,8,'Address of the image data in the .raw-file'); +END. Index: /oup/releases/0.20a/OniUnPacker.bdsproj =================================================================== --- /oup/releases/0.20a/OniUnPacker.bdsproj (revision 21) +++ /oup/releases/0.20a/OniUnPacker.bdsproj (revision 21) @@ -0,0 +1,171 @@ + + + + + + + + + + + + OniUnPacker.dpr + + + 7.0 + + + 8 + 0 + 1 + 1 + 0 + 0 + 1 + 1 + 1 + 0 + 0 + 1 + 0 + 1 + 1 + 1 + 0 + 0 + 0 + 0 + 0 + 1 + 0 + 1 + 1 + 1 + True + True + WinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE; + + False + + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + False + False + False + True + True + True + + + 0 + 0 + 1 + False + False + False + 16384 + 1048576 + 4194304 + + + + + + + + + xmlrtl;rtl;vcl;vclie;inet;inetdbbde;inetdbxpress;vclx;IndySystem;IndyCore;dbrtl;dsnap;soaprtl;IndyProtocols;bdertl;vcldbx;vcldb;webdsnap;websnap;vclactnband;GridPackd2005;TWrapGrid;Package1;A406_R70;CoolTrayIcon_D6plus + + + False + + + + + + False + + + + + + False + + + False + False + 1 + 0 + 0 + 0 + False + False + False + False + False + 1031 + 1252 + + + + + 1.0.0.0 + + + + + + 1.0.0.0 + + + (untitled) + Borland Web Wizard Package + + + Index: /oup/releases/0.20a/OniUnPacker.cfg =================================================================== --- /oup/releases/0.20a/OniUnPacker.cfg (revision 21) +++ /oup/releases/0.20a/OniUnPacker.cfg (revision 21) @@ -0,0 +1,38 @@ +-$A8 +-$B- +-$C+ +-$D+ +-$E- +-$F- +-$G+ +-$H+ +-$I+ +-$J- +-$K- +-$L+ +-$M- +-$N+ +-$O+ +-$P+ +-$Q- +-$R- +-$S- +-$T- +-$U- +-$V+ +-$W- +-$X+ +-$YD +-$Z1 +-cg +-AWinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE; +-H+ +-W+ +-M +-$M16384,1048576 +-K$00400000 +-LE"C:\Dokumente und Einstellungen\Administrator\Eigene Dateien\Borland Studio Projects\Bpl" +-LN"C:\Dokumente und Einstellungen\Administrator\Eigene Dateien\Borland Studio Projects\Bpl" +-w-UNSAFE_TYPE +-w-UNSAFE_CODE +-w-UNSAFE_CAST Index: /oup/releases/0.20a/OniUnPacker.dpr =================================================================== --- /oup/releases/0.20a/OniUnPacker.dpr (revision 21) +++ /oup/releases/0.20a/OniUnPacker.dpr (revision 21) @@ -0,0 +1,24 @@ +PROGRAM OniUnPacker; +uses + Forms, + Unit1_main in 'Unit1_main.pas' {Form1}, + Unit2_functions in 'Unit2_functions.pas', + Unit3_data in 'Unit3_data.pas', + Unit4_Exporters in 'Unit4_Exporters.pas', + Unit5_preview in 'Unit5_preview.pas' {Form5}, + Unit6_imgfuncs in 'Unit6_imgfuncs.pas', + Unit7_txmpreplace in 'Unit7_txmpreplace.pas' {Form7}, + Unit8_binedit in 'Unit8_binedit.pas' {Form8}, + Unit9_data_structures in 'Unit9_data_structures.pas', + Unit10_leveldb in 'Unit10_leveldb.pas' {Form10}, + Unit11_extractor in 'Unit11_extractor.pas' {Form11}; + +{$R *.res} + +BEGIN + Application.Initialize; + Application.Title:='Oni Un/Packer'; + Application.CreateForm(TForm1, Form1); + Application.CreateForm(TForm10, Form10); + Application.Run; +END. Index: /oup/releases/0.20a/SQLite3.pas =================================================================== --- /oup/releases/0.20a/SQLite3.pas (revision 21) +++ /oup/releases/0.20a/SQLite3.pas (revision 21) @@ -0,0 +1,120 @@ +unit SQLite3; + +{ + Simplified interface for SQLite. + Updated for Sqlite 3 by Tim Anderson (tim@itwriting.com) + Note: NOT COMPLETE for version 3, just minimal functionality + Adapted from file created by Pablo Pissanetzky (pablo@myhtpc.net) + which was based on SQLite.pas by Ben Hochstrasser (bhoc@surfeu.ch) +} + +interface + +const +// Return values for sqlite3_exec() and sqlite3_step() + +SQLITE_OK = 0; // Successful result +SQLITE_ERROR = 1; // SQL error or missing database +SQLITE_INTERNAL = 2; // An internal logic error in SQLite +SQLITE_PERM = 3 ; // Access permission denied +SQLITE_ABORT = 4; // Callback routine requested an abort +SQLITE_BUSY = 5; // The database file is locked +SQLITE_LOCKED = 6; // A table in the database is locked +SQLITE_NOMEM = 7; // A malloc() failed +SQLITE_READONLY = 8; // Attempt to write a readonly database +SQLITE_INTERRUPT = 9; // Operation terminated by sqlite3_interrupt() +SQLITE_IOERR = 10; // Some kind of disk I/O error occurred +SQLITE_CORRUPT = 11; // The database disk image is malformed +SQLITE_NOTFOUND = 12; // (Internal Only) Table or record not found +SQLITE_FULL = 13; // Insertion failed because database is full +SQLITE_CANTOPEN = 14; // Unable to open the database file +SQLITE_PROTOCOL = 15; // Database lock protocol error +SQLITE_EMPTY = 16; // Database is empty +SQLITE_SCHEMA = 17; // The database schema changed +SQLITE_TOOBIG = 18; // Too much data for one row of a table +SQLITE_CONSTRAINT = 19; // Abort due to contraint violation +SQLITE_MISMATCH = 20; // Data type mismatch +SQLITE_MISUSE = 21; // Library used incorrectly +SQLITE_NOLFS = 22; // Uses OS features not supported on host +SQLITE_AUTH = 23; // Authorization denied +SQLITE_FORMAT = 24; // Auxiliary database format error +SQLITE_RANGE = 25; // 2nd parameter to sqlite3_bind out of range +SQLITE_NOTADB = 26; // File opened that is not a database file +SQLITE_ROW = 100; // sqlite3_step() has another row ready +SQLITE_DONE = 101; // sqlite3_step() has finished executing + +SQLITE_INTEGER = 1; +SQLITE_FLOAT = 2; +SQLITE_TEXT = 3; +SQLITE_BLOB = 4; +SQLITE_NULL = 5; + +type +TSQLiteDB = Pointer; +TSQLiteResult = ^PChar; +TSQLiteStmt = Pointer; + +function SQLite3_Open (dbname: PChar; var db: TSqliteDB): integer; cdecl; external 'sqlite3.dll' name 'sqlite3_open'; +function SQLite3_Close (db: TSQLiteDB): integer; cdecl; external 'sqlite3.dll' name 'sqlite3_close'; +function SQLite3_Exec (db: TSQLiteDB; SQLStatement: PChar; CallbackPtr: Pointer; Sender: TObject; var ErrMsg: PChar): integer; cdecl; external 'sqlite3.dll' name 'sqlite3_exec'; +function SQLite3_Version (): PChar; cdecl; external 'sqlite3.dll' name 'sqlite3_libversion'; +function SQLite3_ErrMsg (db: TSQLiteDB): PChar; cdecl; external 'sqlite3.dll' name 'sqlite3_errmsg'; +function SQLite3_ErrCode (db: TSQLiteDB): integer; cdecl; external 'sqlite3.dll' name 'sqlite3_errcode'; +procedure SQlite3_Free (P: PChar); cdecl; external 'sqlite3.dll' name 'sqlite3_free'; +function SQLite3_GetTable (db: TSQLiteDB; SQLStatement: PChar; var ResultPtr: TSQLiteResult; var RowCount: Cardinal; var ColCount: Cardinal; var ErrMsg: PChar): integer; cdecl; external 'sqlite3.dll' name 'sqlite3_get_table'; +procedure SQLite3_FreeTable (Table:TSQLiteResult ); cdecl; external 'sqlite3.dll' name 'sqlite3_free_table'; +function SQLite3_Complete (P: PChar): boolean; cdecl; external 'sqlite3.dll' name 'sqlite3_complete'; +function SQLite3_LastInsertRowID(db: TSQLiteDB): int64; cdecl; external 'sqlite3.dll' name 'sqlite3_last_insert_rowid'; +procedure SQLite3_Interrupt (db: TSQLiteDB); cdecl; external 'sqlite3.dll' name 'sqlite3_interrupt'; +procedure SQLite3_BusyHandler (db: TSQLiteDB; CallbackPtr: Pointer; Sender: TObject); cdecl; external 'sqlite3.dll' name'sqlite3_busy_handler' ; +procedure SQLite3_BusyTimeout (db: TSQLiteDB; TimeOut: integer); cdecl; external 'sqlite3.dll' name 'sqlite3_busy_timeout'; +function SQLite3_Changes (db: TSQLiteDB): integer; cdecl; external 'sqlite3.dll' name 'sqlite3_changes'; +function SQLite3_TotalChanges (db: TSQLiteDB): integer; cdecl; external 'sqlite3.dll' name 'sqlite3_total_changes'; +function SQLite3_Prepare (db: TSQLiteDB; SQLStatement: PChar; nBytes: integer; var hStmt: TSqliteStmt; var pzTail: PChar): integer; cdecl; external 'sqlite3.dll' name 'sqlite3_prepare'; +function SQLite3_ColumnCount (hStmt: TSqliteStmt): integer; cdecl; external 'sqlite3.dll' name 'sqlite3_column_count'; +function Sqlite3_ColumnName (hStmt: TSqliteStmt; ColNum: integer): pchar; cdecl; external 'sqlite3.dll' name 'sqlite3_column_name'; +function Sqlite3_ColumnDeclType (hStmt: TSqliteStmt; ColNum: integer): pchar; cdecl; external 'sqlite3.dll' name 'sqlite3_column_decltype'; +function Sqlite3_Step (hStmt: TSqliteStmt): integer; cdecl; external 'sqlite3.dll' name 'sqlite3_step'; +function SQLite3_DataCount (hStmt: TSqliteStmt): integer; cdecl; external 'sqlite3.dll' name 'sqlite3_data_count'; + +function Sqlite3_ColumnBlob (hStmt: TSqliteStmt; ColNum: integer):pointer; cdecl; external 'sqlite3.dll' name 'sqlite3_column_blob'; +function Sqlite3_ColumnBytes (hStmt: TSqliteStmt; ColNum: integer): integer; cdecl; external 'sqlite3.dll' name 'sqlite3_column_bytes'; +function Sqlite3_ColumnDouble (hStmt: TSqliteStmt; ColNum: integer): double; cdecl; external 'sqlite3.dll' name 'sqlite3_column_double'; +function Sqlite3_ColumnInt (hStmt: TSqliteStmt; ColNum: integer): integer; cdecl; external 'sqlite3.dll' name 'sqlite3_column_int'; +function Sqlite3_ColumnText (hStmt: TSqliteStmt; ColNum: integer): pchar; cdecl; external 'sqlite3.dll' name 'sqlite3_column_text'; +function Sqlite3_ColumnType (hStmt: TSqliteStmt; ColNum: integer): integer; cdecl; external 'sqlite3.dll' name 'sqlite3_column_type'; + // function Sqlite3_ColumnInt64 (hStmt: TSqliteStmt; ColNum: integer): SqliteInt64; cdecl; external 'sqlite3.dll' name 'sqlite3_column_int64'; +function SQLite3_Finalize (hStmt: TSqliteStmt): integer; cdecl; external 'sqlite3.dll' name 'sqlite3_finalize'; +function SQLite3_Reset (hStmt: TSqliteStmt): integer; cdecl; external 'sqlite3.dll' name 'sqlite3_reset'; + +// +// In the SQL strings input to sqlite3_prepare() and sqlite3_prepare16(), +// one or more literals can be replace by a wildcard "?" or ":N:" where +// N is an integer. These value of these wildcard literals can be set +// using the routines listed below. +// +// In every case, the first parameter is a pointer to the sqlite3_stmt +// structure returned from sqlite3_prepare(). The second parameter is the +// index of the wildcard. The first "?" has an index of 1. ":N:" wildcards +// use the index N. +// + // The fifth parameter to sqlite3_bind_blob(), sqlite3_bind_text(), and + //sqlite3_bind_text16() is a destructor used to dispose of the BLOB or +//text after SQLite has finished with it. If the fifth argument is the +// special value SQLITE_STATIC, then the library assumes that the information +// is in static, unmanaged space and does not need to be freed. If the +// fifth argument has the value SQLITE_TRANSIENT, then SQLite makes its +// own private copy of the data. +// +// The sqlite3_bind_* routine must be called before sqlite3_step() after +// an sqlite3_prepare() or sqlite3_reset(). Unbound wildcards are interpreted +// as NULL. +// + +function SQLite3_BindBlob(hStmt: TSqliteStmt; ParamNum: integer; +ptrData: pointer; numBytes: integer; ptrDestructor: pointer): integer; +cdecl; external 'sqlite3.dll' name 'sqlite3_bind_blob'; + +implementation + +end. Index: /oup/releases/0.20a/SQLiteTable3.pas =================================================================== --- /oup/releases/0.20a/SQLiteTable3.pas (revision 21) +++ /oup/releases/0.20a/SQLiteTable3.pas (revision 21) @@ -0,0 +1,885 @@ +unit SQLiteTable3; + +{ + Simple classes for using SQLite's exec and get_table. + + TSQLiteDatabase wraps the calls to open and close an SQLite database. + It also wraps SQLite_exec for queries that do not return a result set + + TSQLiteTable wraps sqlite_get_table. + It allows accessing fields by name as well as index and can step through a + result set with the Next procedure. + + Adapted by Tim Anderson (tim@itwriting.com) + Originally created by Pablo Pissanetzky (pablo@myhtpc.net) +} + +interface + +uses + Windows, SQLite3, Classes, Sysutils; + +const + dtStr = 0; + dtInt = 1; + dtBool = 2; + dtNumeric = 3; + dtBlob = 4; + +type + + ESQLiteException = class(Exception) + private + public + end; + + TSQLiteTable = class; + + TSQLiteDatabase = class + private + fDB: TSQLiteDB; + fInTrans: Boolean; + procedure RaiseError(s: string; SQL: string); + + public + constructor Create(const FileName: string); + destructor Destroy; override; + function GetTable(const SQL: string): TSQLiteTable; + procedure ExecSQL(const SQL: string); + procedure UpdateBlob(const SQL: string; BlobData: TStream); + procedure BeginTransaction; + procedure Commit; + procedure Rollback; + function TableExists(TableName: string): boolean; + function GetLastInsertRowID: int64; + + published + property isTransactionOpen: boolean read fInTrans; + + end; + + TSQLiteTable = class + private + fResults: TList; + fRowCount: Cardinal; + fColCount: Cardinal; + fCols: TStringList; + fColTypes: TList; + fRow: Cardinal; + + function GetFields(I: Integer): string; + function GetEOF: Boolean; + function GetBOF: Boolean; + function GetColumns(I: Integer): string; + function GetFieldByName(FieldName: string): string; + function GetFieldIndex(FieldName: string): integer; + function GetCount: Integer; + function GetCountResult: Integer; + + + public + constructor Create(DB: TSQLiteDatabase; const SQL: string); + destructor Destroy; override; + function FieldAsInteger(FieldName: string): integer; + function FieldAsBool(FieldName: string): boolean; + function FieldAsBlob(FieldName: string): TMemoryStream; + function FieldAsBlobText(FieldName: string): string; + function FieldIsNull(FieldName: string): boolean; + function FieldAsString(FieldName: string): string; + function FieldAsDouble(FieldName: string): double; +{ function FieldAsInteger(I: integer): integer; + function FieldAsBool(I: integer): boolean; + function FieldAsBlob(I: Integer): TMemoryStream; + function FieldAsBlobText(I: Integer): string; + function FieldIsNull(I: integer): boolean; + function FieldAsString(I: Integer): string; + function FieldAsDouble(I: Integer): double; +} function Next: Boolean; + function Previous: Boolean; + property EOF: Boolean read GetEOF; + property BOF: Boolean read GetBOF; + property Fields[I: Integer]: string read GetFields; + property FieldByName[FieldName: string]: string read GetFieldByName; + property FieldIndex[FieldName: string]: integer read GetFieldIndex; + property Columns[I: Integer]: string read GetColumns; + property ColCount: Cardinal read fColCount; + property RowCount: Cardinal read fRowCount; + property Row: Cardinal read fRow; + function MoveFirst: boolean; + function MoveLast: boolean; + + + property Count: Integer read GetCount; + + // The property CountResult is used when you execute count(*) queries. + // It returns 0 if the result set is empty or the value of the + // first field as an integer. + property CountResult: Integer read GetCountResult; + end; + + +procedure DisposePointer(ptr: pointer); cdecl; + +implementation + +uses + strutils; + + +procedure DisposePointer(ptr: pointer); cdecl; +begin + + if assigned(ptr) then + begin freemem(ptr) end; + +end; + +//------------------------------------------------------------------------------ +// TSQLiteDatabase +//------------------------------------------------------------------------------ + +constructor TSQLiteDatabase.Create(const FileName: string); +var + Msg: pchar; + iResult: integer; +begin + inherited Create; + + self.fInTrans := false; + + Msg := nil; + try + iResult := SQLite3_Open(PChar(FileName), Fdb); + + if iResult <> SQLITE_OK then + begin + if Assigned(Fdb) then + begin + Msg := Sqlite3_ErrMsg(Fdb); + raise ESqliteException.CreateFmt('Failed to open database "%s" : %s', [FileName, Msg]); + end + else + begin raise ESqliteException.CreateFmt('Failed to open database "%s" : unknown error', [FileName]) end; + end; + + //set a few configs + self.ExecSQL('PRAGMA SYNCHRONOUS=NORMAL;'); + + //this pragma not recommended and may disappear in future + //sqlite versions + //self.ExecSQL('PRAGMA full_column_names = 1;'); + + finally + if Assigned(Msg) then + begin SQLite3_Free(Msg) end; + end; + + +end; + + +//.............................................................................. + +destructor TSQLiteDatabase.Destroy; +begin + + if self.fInTrans then + begin self.ExecSQL('ROLLBACK;') end; //assume rollback + + if Assigned(fDB) then + begin SQLite3_Close(fDB) end; + + inherited; +end; + +function TSQLiteDatabase.GetLastInsertRowID: int64; +begin + result := Sqlite3_LastInsertRowID(self.fDB); +end; + +//.............................................................................. + +procedure TSQLiteDatabase.RaiseError(s: string; SQL: string); +//look up last error and raise and exception with an appropriate message +var + Msg: PChar; +begin + + Msg := nil; + + if sqlite3_errcode(self.fDB) <> SQLITE_OK then + Msg := sqlite3_errmsg(self.fDB); + + IF Pos('DROP TABLE ',SQL)>0 THEN Exit; + + if Msg <> nil then + raise ESqliteException.CreateFmt(s + ' "%s" : %s', [SQL, Msg]) + else + raise ESqliteException.CreateFmt(s, [SQL, 'No message']); + +end; + +procedure TSQLiteDatabase.ExecSQL(const SQL: string); +var + Stmt: TSQLiteStmt; + NextSQLStatement: Pchar; + iStepResult: integer; +begin + try + + if Sqlite3_Prepare(self.fDB, PChar(SQL), -1, Stmt, NextSQLStatement) <> SQLITE_OK then + begin RaiseError('Error executing SQL', SQL) end; + + if (Stmt = nil) then + begin RaiseError('Could not prepare SQL statement', SQL) end; + + iStepResult := Sqlite3_step(Stmt); + + if (iStepResult <> SQLITE_DONE) then + begin RaiseError('Error executing SQL statement', SQL) end; + + finally + + if Assigned(Stmt) then + begin Sqlite3_Finalize(stmt) end; + + end; +end; + +procedure TSQLiteDatabase.UpdateBlob(const SQL: string; BlobData: TStream); +var + iSize: integer; + ptr: pointer; + Stmt: TSQLiteStmt; + Msg: Pchar; + NextSQLStatement: Pchar; + iStepResult: integer; + iBindResult: integer; +begin +//expects SQL of the form 'UPDATE MYTABLE SET MYFIELD = ? WHERE MYKEY = 1' + + if pos('?', SQL) = 0 then + begin RaiseError('SQL must include a ? parameter', SQL) end; + + Msg := nil; + try + + if Sqlite3_Prepare(self.fDB, PChar(SQL), -1, Stmt, NextSQLStatement) <> SQLITE_OK then + begin RaiseError('Could not prepare SQL statement', SQL) end; + + if (Stmt = nil) then + begin RaiseError('Could not prepare SQL statement', SQL) end; + +//now bind the blob data + iSize := BlobData.size; + + GetMem(ptr, iSize); + + if (ptr = nil) then + begin raise ESqliteException.CreateFmt('Error getting memory to save blob', [SQL, 'Error']) end; + + BlobData.position := 0; + BlobData.Read(ptr^, iSize); + + iBindResult := SQLite3_BindBlob(stmt, 1, ptr, iSize, @DisposePointer); + + if iBindResult <> SQLITE_OK then + begin RaiseError('Error binding blob to database', SQL) end; + + iStepResult := Sqlite3_step(Stmt); + + if (iStepResult <> SQLITE_DONE) then + begin RaiseError('Error executing SQL statement', SQL) end; + + finally + + if Assigned(Stmt) then + begin Sqlite3_Finalize(stmt) end; + + if Assigned(Msg) then + begin SQLite3_Free(Msg) end; + end; + +end; + +//.............................................................................. + +function TSQLiteDatabase.GetTable(const SQL: string): TSQLiteTable; +begin + Result := TSQLiteTable.Create(Self, SQL); +end; + +procedure TSQLiteDatabase.BeginTransaction; +begin + if not self.fInTrans then + begin + self.ExecSQL('BEGIN TRANSACTION;'); + self.fInTrans := true; + end + else + begin raise ESqliteException.Create('Transaction already open') end; +end; + +procedure TSQLiteDatabase.Commit; +begin + self.ExecSQL('COMMIT;'); + self.fInTrans := false; +end; + +procedure TSQLiteDatabase.Rollback; +begin + self.ExecSQL('ROLLBACK;'); + self.fInTrans := false; +end; + +function TSQLiteDatabase.TableExists(TableName: string): boolean; +var + sql: string; + ds: TSqliteTable; +begin +//returns true if table exists in the database + sql := 'select [sql] from sqlite_master where [type] = ''table'' and lower(name) = ''' + lowercase(TableName) + ''' '; + + try + + ds := self.GetTable(sql); + + result := (ds.Count > 0); + + finally + + freeandnil(ds); + + end; + +end; + + +//------------------------------------------------------------------------------ +// TSQLiteTable +//------------------------------------------------------------------------------ + +constructor TSQLiteTable.Create(DB: TSQLiteDatabase; const SQL: string); +var + Stmt: TSQLiteStmt; + NextSQLStatement: Pchar; + iStepResult: integer; + + ptr: pointer; + iNumBytes: integer; + thisBlobValue: TMemoryStream; + thisStringValue: pstring; + thisBoolValue: pBoolean; + thisDoubleValue: pDouble; + thisIntValue: pInteger; + thisColType: pInteger; + i: integer; + DeclaredColType: Pchar; + ActualColType: integer; + ptrValue: Pchar; + +begin + + try + + self.fRowCount := 0; + self.fColCount := 0; + +//if there are several SQL statements in SQL, NextSQLStatment points to the +//beginning of the next one. Prepare only prepares the first SQL statement. + + if Sqlite3_Prepare(Db.fDB, PChar(SQL), -1, Stmt, NextSQLStatement) <> SQLITE_OK then + begin Db.RaiseError('Error executing SQL', SQL) end; + + if (Stmt = nil) then + begin Db.RaiseError('Could not prepare SQL statement', SQL) end; + + iStepResult := Sqlite3_step(Stmt); + + while (iStepResult <> SQLITE_DONE) do + begin + + case iStepResult of + SQLITE_ROW: + begin + + inc(fRowCount); + + if (fRowCount = 1) then + begin + //get data types + fCols := TStringList.Create; + fCols.CaseSensitive := False; + fColTypes := TList.Create; + + fColCount := SQLite3_ColumnCount(stmt); + + for i := 0 to Pred(fColCount) do + begin + fCols.Add(Sqlite3_ColumnName(stmt, i)); + end; + + for i := 0 to Pred(fColCount) do + begin + + new(thisColType); + DeclaredColType := Sqlite3_ColumnDeclType(stmt, i); + + if DeclaredColType = nil then begin + //use the actual column type instead + //seems to be needed for last_insert_rowid + thisColType^ := Sqlite3_ColumnType(stmt, i); + end else begin + DeclaredColType := strupper(DeclaredColType); + + if DeclaredColType = 'INTEGER' then + begin thisColType^ := dtInt end + else + if DeclaredColType = 'BOOLEAN' then + begin thisColType^ := dtBool end + else + if (DeclaredColType = 'NUMERIC') or (DeclaredColType = 'FLOAT') or (DeclaredColType = 'DOUBLE') then + begin thisColType^ := dtNumeric end + else + if DeclaredColType = 'BLOB' then + begin thisColType^ := dtBlob end + else + begin thisColType^ := dtStr end; + end; + + fColTypes.Add(thiscoltype); + end; + + fResults := TList.Create; + + end; + + //get column values + for i := 0 to Pred(ColCount) do + begin + + ActualColType := Sqlite3_ColumnType(stmt, i); + if (ActualColType = SQLITE_NULL) then + begin fResults.Add(nil) end + else + begin + if pInteger(fColTypes[i])^ = dtInt then + begin + new(thisintvalue); + thisintvalue^ := Sqlite3_ColumnInt(stmt, i); + fResults.Add(thisintvalue); + end + else + if pInteger(fColTypes[i])^ = dtBool then + begin + new(thisboolvalue); + thisboolvalue^ := not (Sqlite3_ColumnInt(stmt, i) = 0); + fResults.Add(thisboolvalue); + end + else + if pInteger(fColTypes[i])^ = dtNumeric then + begin + new(thisdoublevalue); + thisdoublevalue^ := Sqlite3_ColumnDouble(stmt, i); + fResults.Add(thisdoublevalue); + end + else + if pInteger(fColTypes[i])^ = dtBlob then + begin + iNumBytes := Sqlite3_ColumnBytes(stmt, i); + + if iNumBytes = 0 then + begin thisblobvalue := nil end + else + begin + thisblobvalue := TMemoryStream.Create; + thisblobvalue.position := 0; + ptr := Sqlite3_ColumnBlob(stmt, i); + thisblobvalue.writebuffer(ptr^, iNumBytes); + end; + fResults.Add(thisblobvalue); + + end + else + begin + new(thisstringvalue); + ptrValue := Sqlite3_ColumnText(stmt, i); + setstring(thisstringvalue^, ptrvalue, strlen(ptrvalue)); + fResults.Add(thisstringvalue); + end; + end; + + end; + + + + end; + + SQLITE_BUSY: + begin raise ESqliteException.CreateFmt('Could not prepare SQL statement', [SQL, 'SQLite is Busy']) end; + else + begin Db.RaiseError('Could not retrieve data', SQL) end; + end; + + iStepResult := Sqlite3_step(Stmt); + + end; + + fRow := 0; + + finally + if Assigned(Stmt) then + begin Sqlite3_Finalize(stmt) end; + end; + +end; + +//.............................................................................. + +destructor TSQLiteTable.Destroy; +var i: integer; + iColNo: integer; +begin + + + if Assigned(fResults) then + begin for i := 0 to fResults.Count - 1 do + begin + //check for blob type + iColNo := (i mod fColCount); + case pInteger(self.fColTypes[iColNo])^ of + dtBlob: + begin + TMemoryStream(fResults[i]).free; + end; + dtStr: + begin + if fResults[i] <> nil then + begin + setstring(string(fResults[i]^), nil, 0); + dispose(fResults[i]); + end; + end; + else + begin + dispose(fResults[i]) + end; + end; + end; + fResults.Free; + end; + + if Assigned(fCols) then + begin fCols.Free end; + + if Assigned(fColTypes) then + begin for i := 0 to fColTypes.Count - 1 do + begin + dispose(fColTypes[i]); + end end; + fColTypes.Free; + inherited; + end; + +//.............................................................................. + +function TSQLiteTable.GetColumns(I: Integer): string; +begin + Result := fCols[I]; +end; + +//.............................................................................. + +function TSQLiteTable.GetCountResult: Integer; +begin + if not EOF then + begin Result := StrToInt(Fields[0]) end + else + begin Result := 0 end; +end; + +function TSQLiteTable.GetCount: Integer; +begin + Result := FRowCount; +end; + +//.............................................................................. + +function TSQLiteTable.GetEOF: Boolean; +begin + Result := fRow >= fRowCount; +end; + +function TSQLiteTable.GetBOF: Boolean; +begin + Result := fRow <= 0; +end; + +//.............................................................................. + +function TSQLiteTable.GetFieldByName(FieldName: string): string; +begin + Result := GetFields(self.GetFieldIndex(FieldName)); +end; + +function TSQLiteTable.GetFieldIndex(FieldName: string): integer; +begin + + if (fCols = nil) then + begin + raise ESqliteException.Create('Field ' + fieldname + ' Not found. Empty dataset'); + exit; + end; + + if (fCols.count = 0) then + begin + raise ESqliteException.Create('Field ' + fieldname + ' Not found. Empty dataset'); + exit; + end; + + result := fCols.IndexOf(FieldName); + + if (result < 0) then + begin raise ESqliteException.Create('Field not found in dataset: ' + fieldname) end; + +end; + +//.............................................................................. + +function TSQLiteTable.GetFields(I: Integer): string; +var + thisvalue: pstring; + ptr: pointer; + thisboolvalue: pBoolean; + thistype: integer; +begin + Result := ''; + + if EOF then + begin raise ESqliteException.Create('Table is at End of File') end; + +//integer and boolean types are not stored in the resultset +//as strings, so they should be retrieved using the type-specific +//methods + + thistype := pInteger(self.fColTypes[I])^; + + if (thistype = dtInt) or (thistype = dtNumeric) or (thistype = dtBlob) then + begin + ptr := self.fResults[(self.frow * self.fColCount) + I]; + + if ptr <> nil then + begin + raise ESqliteException.Create('Use the specific methods for integer, numeric or blob fields'); + end; + + end + else + if pInteger(self.fColTypes[I])^ = dtBool then + begin + thisboolvalue := self.fResults[(self.frow * self.fColCount) + I]; + if thisboolvalue <> nil then + begin if thisboolvalue^ then + begin result := '1' end + else + begin result := '0' end end; + end + + else + + begin + + thisvalue := self.fResults[(self.frow * self.fColCount) + I]; + if (thisvalue <> nil) then + begin Result := thisvalue^ end + else + begin Result := '' end; //return empty string + end; + +end; + +function TSqliteTable.FieldAsBlob(FieldName: string): TMemoryStream; +var + i: Integer; +begin + + if EOF then + begin raise ESqliteException.Create('Table is at End of File') end; + + i:=Self.FieldIndex[FieldName]; + + if (self.fResults[(self.frow * self.fColCount) + I] = nil) then + begin result := nil end + else + if pInteger(self.fColTypes[I])^ = dtBlob then + begin result := TMemoryStream(self.fResults[(self.frow * self.fColCount) + I]) end + else + begin raise ESqliteException.Create('Not a Blob field') end; +end; + +function TSqliteTable.FieldAsBlobText(FieldName: string): string; +var + MemStream: TMemoryStream; + Buffer: PChar; +begin + result := ''; + + MemStream := self.FieldAsBlob(FieldName); + + if MemStream <> nil then + begin if MemStream.Size > 0 then + begin + MemStream.position := 0; + + Buffer := stralloc(MemStream.Size + 1); + MemStream.readbuffer(Buffer[0], MemStream.Size); + (Buffer + MemStream.Size)^ := chr(0); + SetString(Result, Buffer, MemStream.size); + strdispose(Buffer); + end end; + +end; + + +function TSqliteTable.FieldAsInteger(FieldName: string): integer; +var + i: Integer; +begin + + if EOF then + begin raise ESqliteException.Create('Table is at End of File') end; + + i:=Self.FieldIndex[FieldName]; + + if (self.fResults[(self.frow * self.fColCount) + I] = nil) then + begin result := 0 end + else + if pInteger(self.fColTypes[I])^ = dtInt then + begin result := pInteger(self.fResults[(self.frow * self.fColCount) + I])^ end + else + if pInteger(self.fColTypes[I])^ = dtNumeric then + begin result := trunc(strtofloat(pString(self.fResults[(self.frow * self.fColCount) + I])^)) end + else + begin raise ESqliteException.Create('Not an integer or numeric field') end; + +end; + +function TSqliteTable.FieldAsDouble(FieldName: string): double; +var + i: Integer; +begin + + if EOF then + begin raise ESqliteException.Create('Table is at End of File') end; + + i:=Self.FieldIndex[FieldName]; + + if (self.fResults[(self.frow * self.fColCount) + I] = nil) then + begin result := 0 end + else + if pInteger(self.fColTypes[I])^ = dtInt then + begin result := pInteger(self.fResults[(self.frow * self.fColCount) + I])^ end + else + if pInteger(self.fColTypes[I])^ = dtNumeric then + begin result := pDouble(self.fResults[(self.frow * self.fColCount) + I])^ end + else + begin raise ESqliteException.Create('Not an integer or numeric field') end; + +end; + +function TSqliteTable.FieldAsBool(FieldName: string): boolean; +var + i: Integer; +begin + + if EOF then + begin raise ESqliteException.Create('Table is at End of File') end; + + i:=Self.FieldIndex[FieldName]; + + if (self.fResults[(self.frow * self.fColCount) + I] = nil) then + begin result := false end + else + if pInteger(self.fColTypes[I])^ = dtBool then + begin result := pBoolean(self.fResults[(self.frow * self.fColCount) + I])^ end + else + begin raise ESqliteException.Create('Not a boolean field') end; +end; + +function TSqliteTable.FieldAsString(FieldName: string): string; +var + i: Integer; +begin + + if EOF then + begin raise ESqliteException.Create('Table is at End of File') end; + + i:=Self.FieldIndex[FieldName]; + + if (self.fResults[(self.frow * self.fColCount) + I] = nil) then + begin result := '' end + else + begin result := self.GetFields(I) end; + +end; + +function TSqliteTable.FieldIsNull(FieldName: string): boolean; +var + thisvalue: pointer; + i: Integer; +begin + + if EOF then + begin raise ESqliteException.Create('Table is at End of File') end; + + i:=Self.FieldIndex[FieldName]; + + thisvalue := self.fResults[(self.frow * self.fColCount) + I]; + result := (thisvalue = nil); +end; + +//.............................................................................. + +function TSQLiteTable.Next: boolean; +begin + result := false; + if not EOF then + begin + Inc(fRow); + result := true; + end; +end; + +function TSQLiteTable.Previous: boolean; +begin + result := false; + if not BOF then + begin + Dec(fRow); + result := true; + end; +end; + +function TSQLiteTable.MoveFirst: boolean; +begin + result := false; + if self.fRowCount > 0 then + begin + fRow := 0; + result := true; + end; +end; + +function TSQLiteTable.MoveLast: boolean; +begin + result := false; + if self.fRowCount > 0 then + begin + fRow := fRowCount - 1; + result := true; + end; +end; + + +end. + Index: /oup/releases/0.20a/Unit10_leveldb.dfm =================================================================== --- /oup/releases/0.20a/Unit10_leveldb.dfm (revision 21) +++ /oup/releases/0.20a/Unit10_leveldb.dfm (revision 21) @@ -0,0 +1,61 @@ +object Form10: TForm10 + Left = 0 + Top = 0 + BorderStyle = bsNone + Caption = 'Creating DB' + ClientHeight = 90 + ClientWidth = 401 + Color = clBtnFace + Font.Charset = DEFAULT_CHARSET + Font.Color = clWindowText + Font.Height = -11 + Font.Name = 'Tahoma' + Font.Style = [] + OldCreateOrder = False + Position = poScreenCenter + PixelsPerInch = 96 + TextHeight = 13 + object group_progress: TGroupBox + Left = 0 + Top = 0 + Width = 400 + Height = 89 + Caption = 'Progress ...' + TabOrder = 0 + object lbl_progress: TLabel + Left = 2 + Top = 32 + Width = 396 + Height = 17 + Align = alTop + AutoSize = False + end + object lbl_estimation: TLabel + Left = 2 + Top = 49 + Width = 396 + Height = 17 + Align = alTop + AutoSize = False + Caption = 'Estimated finishing time:' + end + object progress: TProgressBar + Left = 2 + Top = 15 + Width = 396 + Height = 17 + Align = alTop + Smooth = True + TabOrder = 0 + end + object btn_abortok: TButton + Left = 3 + Top = 64 + Width = 60 + Height = 22 + Caption = 'Abort...' + TabOrder = 1 + OnClick = btn_abortokClick + end + end +end Index: /oup/releases/0.20a/Unit10_leveldb.pas =================================================================== --- /oup/releases/0.20a/Unit10_leveldb.pas (revision 21) +++ /oup/releases/0.20a/Unit10_leveldb.pas (revision 21) @@ -0,0 +1,986 @@ +UNIT Unit10_leveldb; +INTERFACE +USES + Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, + Dialogs, ComCtrls, StdCtrls; + +TYPE + TForm10 = Class(TForm) + group_progress: TGroupBox; + progress: TProgressBar; + lbl_progress: TLabel; + btn_abortok: TButton; + lbl_estimation: TLabel; + PROCEDURE btn_abortokClick(Sender: TObject); + PRIVATE + PROCEDURE HandleFile(ext:String; fileid:LongWord; dir_dat2db:Boolean); + PROCEDURE stop_convert; + PUBLIC + PROCEDURE CreateDatabase(FileName:String); + END; + + +VAR + Form10: TForm10; + +IMPLEMENTATION +{$R *.dfm} +USES SQLiteTable3, Unit1_main, Unit2_functions, Unit3_data; +TYPE + THandler=PROCEDURE(fileid:LongWord; dir_dat2db:Boolean); + TConvertHandlers=RECORD + Ext:String[4]; + needed:Boolean; + Handler:THandler; + END; +VAR + ConvertHandlers:Array OF TConvertHandlers; + loaded_filename:String; + converting:Boolean=False; + abort:Boolean=False; + filestream:TFileStream; + dat_stream,mem:TMemoryStream; + +PROCEDURE TForm10.HandleFile; + VAR + i:Byte; + BEGIN + FOR i:=1 TO Length(ConvertHandlers) DO + IF UpperCase(ConvertHandlers[i].Ext)=UpperCase(ext) THEN + IF ConvertHandlers[i].needed THEN BEGIN + ConvertHandlers[i].Handler(fileid, dir_dat2db); + Break; + END ELSE + Break; + END; + +PROCEDURE TForm10.CreateDatabase(FileName:String); + VAR + i,j:LongWord; + temps,temps2:String; + data:Tdata; + absolutebegintime,begintime:Double; + step:Byte; + CONST + steps:Byte=4; + PROCEDURE DoStep(stepname:String); + BEGIN + Inc(step); + IF stepname<>'FIN' THEN + group_progress.Caption:='Creating DB (Step '+IntToStr(step)+'/'+IntToStr(steps)+': '+stepname+')' + ELSE + group_progress.Caption:='Creating DB (FINISHED)'; + END; + BEGIN + Form10.Visible:=True; + Form1.Visible:=False; + step:=0; + converting:=True; + abort:=False; + loaded_filename:=FileName; + btn_abortok.Caption:='&Abort...'; + btn_abortok.Default:=False; + + absolutebegintime:=Time; + + DB:=TSQLiteDatabase.Create(FileName); + DB.ExecSQL('PRAGMA synchronous = 0;'); + DB.ExecSQL('PRAGMA temp_store = 2;'); + DB.ExecSQL('DROP TABLE globals;'); + DB.ExecSQL('DROP TABLE linkmap;'); + DB.ExecSQL('DROP TABLE rawmap;'); + DB.ExecSQL('DROP TABLE datfiles;'); + DB.ExecSQL('DROP TABLE extlist;'); + DB.ExecSQL('VACUUM;'); + + DoStep('Creating tables'); + progress.Position:=0; + lbl_progress.Caption:=''; + lbl_estimation.Caption:='Estimated finishing time: unknown'; + Application.ProcessMessages; + + DB.ExecSQL('CREATE TABLE globals (id INTEGER PRIMARY KEY AUTOINCREMENT, name VARCHAR (20), value VARCHAR (50) );'); + DB.ExecSQL('CREATE TABLE linkmap (id INTEGER PRIMARY KEY AUTOINCREMENT, src_id INTEGER, src_link_offset INTEGER, target_id INTEGER );'); + DB.ExecSQL('CREATE TABLE rawmap (id INTEGER PRIMARY KEY AUTOINCREMENT, src_id INTEGER, src_link_offset INTEGER, data BLOB );'); + DB.ExecSQL('CREATE TABLE datfiles (id INTEGER PRIMARY KEY, extension VARCHAR(4), name VARCHAR(128), contenttype INTEGER, data BLOB );'); + DB.ExecSQL('CREATE TABLE extlist (id INTEGER PRIMARY KEY AUTOINCREMENT, ext VARCHAR(4), ident VARCHAR(16) );'); + + DB.ExecSQL('INSERT INTO globals (name,value) VALUES ("dbversion","'+dbversion+'");'); + SetLength(data,Length(dat_header.Ident)); + FOR i:=0 TO High(dat_header.Ident) DO data[i]:=dat_header.Ident[i]; + temps:=CreateHexString(data,True); + DB.ExecSQL('INSERT INTO globals (name,value) VALUES ("ident","'+temps+'");'); + data:=LoadDatFile(0); + i:=data[7]; + i:=i DIV 2; + DB.ExecSQL('INSERT INTO globals (name,value) VALUES ("lvl","'+IntToStr(i)+'");'); + + DoStep('Writing extensionslist'); + progress.Max:=dat_header.Extensions; + Application.ProcessMessages; + + FOR i:=0 TO dat_header.Extensions-1 DO BEGIN + SetLength(data,Length(dat_extensionsmap[i].Ident)); + FOR j:=0 TO High(dat_extensionsmap[i].Ident) DO data[j]:=dat_extensionsmap[i].Ident[j]; + temps:=CreateHexString(data,True); + temps2:=dat_extensionsmap[i].Extension[3]+dat_extensionsmap[i].Extension[2]+dat_extensionsmap[i].Extension[1]+dat_extensionsmap[i].Extension[0]; + DB.ExecSQL('INSERT INTO extlist (ext,ident) VALUES ("'+temps2+'","'+temps+'");'); + progress.Position:=i; + lbl_progress.Caption:='Extensions done: '+IntToStr(i)+'/'+IntToStr(dat_header.Extensions); + Application.ProcessMessages; + IF abort THEN BEGIN + stop_convert; + Exit; + END; + END; + lbl_progress.Caption:=''; + + DoStep('Loading .dat into memory'); + Application.ProcessMessages; + + progress.Position:=0; + lbl_progress.Caption:='Files done: '+IntToStr(0)+'/'+IntToStr(dat_header.Files); + lbl_estimation.Caption:='Estimated finishing time: unknown'; + + filestream:=TFileStream.Create(dat_filename, fmOpenRead); + dat_stream:=TMemoryStream.Create; + dat_stream.CopyFrom(filestream,0); + dat_stream.Seek(0,soFromBeginning); + filestream.Free; + + progress.Max:=dat_header.Files; + begintime:=Time; + DoStep('Writing .dat-fileslist'); + Application.ProcessMessages; + + FOR i:=0 TO dat_header.Files-1 DO BEGIN + DB.ExecSQL('INSERT INTO datfiles (id,extension,name,contenttype) VALUES ('+IntToStr(i)+',"'+dat_files[i].Extension+'","'+dat_files[i].Name+'","'+IntToHex(dat_files[i].FileType,8)+'");'); + IF (dat_files[i].FileType AND $02)=0 THEN BEGIN + dat_stream.Seek(dat_files[i].DatAddr,soFromBeginning); + mem:=TMemoryStream.Create; + mem.CopyFrom(dat_stream,dat_files[i].Size); + mem.Seek(0,soFromBeginning); + DB.UpdateBlob('UPDATE datfiles SET data = ? WHERE id='+IntToStr(i)+';',mem); + HandleFile(dat_files[i].Extension,i,True); + mem.Free; + END; + IF ( (i MOD 50)=0 ) AND (i>=100) THEN + lbl_estimation.Caption:='Estimated finishing time: '+TimeToStr((Time-begintime)/i*dat_header.Files+begintime); + IF (i MOD 5)=0 THEN BEGIN + progress.Position:=i; + lbl_progress.Caption:='Files done: '+IntToStr(i)+'/'+IntToStr(dat_header.Files); + Application.ProcessMessages; + END; + IF abort THEN BEGIN + stop_convert; + Exit; + END; + END; + progress.Position:=dat_header.Files; + lbl_progress.Caption:='Files done: '+IntToStr(dat_header.Files)+'/'+IntToStr(dat_header.Files); + lbl_estimation.Caption:='FINISHED (duration: '+TimeToStr(Time-absolutebegintime)+')'; + + DoStep('FIN'); + btn_abortok.Caption:='&OK'; + btn_abortok.Default:=True; + + loaded_filename:=''; + converting:=False; + dat_stream.Free; + DB.Free; + END; + +PROCEDURE TForm10.stop_convert; + BEGIN + btn_abortok.Caption:='&Close'; + btn_abortok.Default:=True; + converting:=False; + lbl_estimation.Caption:='ABORTED'; + group_progress.Caption:='Creating DB (ABORTED)'; + IF MessageBox(Self.Handle, PChar('Delete the unfinished DB-file?'), PChar('Delete file?'), MB_YESNO)=IDYES THEN BEGIN + DB.Free; + DeleteFile(loaded_filename); + END; + END; + +PROCEDURE TForm10.btn_abortokClick(Sender: TObject); + BEGIN + IF converting THEN BEGIN + IF MessageBox(Self.Handle, PChar('Do you really want to cancel the convert-progress?'), PChar('Warning: Converting'), MB_YESNO)=IDYES THEN + abort:=True; + END ELSE BEGIN + Form10.Visible:=False; + Form1.Visible:=True; + END; + END; + + +PROCEDURE LoadFilePart(offset,size:LongWord; target:Pointer); + BEGIN + mem.Seek(offset,soFromBeginning); + mem.Read(target^,size); + END; + +PROCEDURE InsertDatLinkToDB(fileid:LongWord; offset:LongWord); + VAR + link:LongWord; + BEGIN + LoadFilePart(offset,4,@link); + IF link=0 THEN + link:=$FFFFFFFF + ELSE + link:=link DIV 256; + DB.ExecSQL('INSERT INTO linkmap (src_id,src_link_offset,target_id) VALUES ('+IntToStr(fileid)+','+IntToStr(offset)+','+IntToStr(link)+');'); + END; + +PROCEDURE InsertRawFileToDB(fileid:LongWord; src_offset,raw_addr,size:LongWord); + VAR + localmem:TMemoryStream; + BEGIN + localmem:=TMemoryStream.Create; + filestream:=TFileStream.Create(raw_filename,fmOpenRead); + filestream.Seek(raw_addr,soFromBeginning); + localmem.CopyFrom(filestream,size); + filestream.Free; + DB.ExecSQL('INSERT INTO rawmap (src_id,src_link_offset) VALUES ('+IntToStr(fileid)+','+IntToStr(src_offset)+');'); + DB.UpdateBlob('UPDATE rawmap SET data = ? WHERE src_id='+IntToStr(fileid),localmem); + localmem.Free; + END; + + + +PROCEDURE AGDB(fileid:LongWord; dir_dat2db:Boolean); + VAR + link:LongWord; + links:LongWord; + i:LongWord; + BEGIN + IF dir_dat2db THEN BEGIN + LoadFilePart($1C,4,@links); + links:=links*2; + FOR i:=0 TO links-1 DO BEGIN + LoadFilePart($20+i*4,4,@link); + InsertRawFileToDB(fileid,$20+i*4,link,1{????????????????????????????????}); + END; + END ELSE BEGIN + END; + END; +PROCEDURE AKEV(fileid:LongWord; dir_dat2db:Boolean); + VAR + i:LongWord; + BEGIN + IF dir_dat2db THEN BEGIN + FOR i:=0 TO 16 DO InsertDatLinkToDB(fileid,$8+i*4); + END ELSE BEGIN + END; + END; +PROCEDURE AKOT(fileid:LongWord; dir_dat2db:Boolean); + VAR + i:LongWord; + BEGIN + IF dir_dat2db THEN BEGIN + FOR i:=0 TO 4 DO InsertDatLinkToDB(fileid,$8+i*4); + END ELSE BEGIN + END; + END; +PROCEDURE BINA(fileid:LongWord; dir_dat2db:Boolean); + VAR + link:LongWord; + datasize:LongWord; + BEGIN + IF dir_dat2db THEN BEGIN + LoadFilePart($0C,4,@link); + LoadFilePart($08,4,@datasize); + InsertRawFileToDB(fileid,$0C,link,datasize); + END ELSE BEGIN + END; + END; +PROCEDURE CBPI(fileid:LongWord; dir_dat2db:Boolean); + VAR + i:LongWord; + BEGIN + IF dir_dat2db THEN BEGIN + FOR i:=0 TO 56 DO InsertDatLinkToDB(fileid,$8+i*4); + END ELSE BEGIN + END; + END; +PROCEDURE CBPM(fileid:LongWord; dir_dat2db:Boolean); + VAR + i:LongWord; + BEGIN + IF dir_dat2db THEN BEGIN + FOR i:=0 TO 18 DO InsertDatLinkToDB(fileid,$8+i*4); + END ELSE BEGIN + END; + END; +PROCEDURE CONS(fileid:LongWord; dir_dat2db:Boolean); + VAR + i:LongWord; + BEGIN + IF dir_dat2db THEN BEGIN + FOR i:=0 TO 1 DO InsertDatLinkToDB(fileid,$24+i*4); + END ELSE BEGIN + END; + END; +PROCEDURE CRSA(fileid:LongWord; dir_dat2db:Boolean); + VAR + packages:LongWord; + i:LongWord; + BEGIN + IF dir_dat2db THEN BEGIN + LoadFilePart($14,4,@packages); + IF packages>0 THEN + FOR i:=0 TO packages-1 DO InsertDatLinkToDB(fileid,$20+i*1100+$A0); + END ELSE BEGIN + END; + END; +PROCEDURE DOOR(fileid:LongWord; dir_dat2db:Boolean); + BEGIN + IF dir_dat2db THEN BEGIN + InsertDatLinkToDB(fileid,$08); + InsertDatLinkToDB(fileid,$10); + END ELSE BEGIN + END; + END; +PROCEDURE DPGE(fileid:LongWord; dir_dat2db:Boolean); + BEGIN + IF dir_dat2db THEN BEGIN + InsertDatLinkToDB(fileid,$40); + END ELSE BEGIN + END; + END; +PROCEDURE HPGE(fileid:LongWord; dir_dat2db:Boolean); + BEGIN + IF dir_dat2db THEN BEGIN + InsertDatLinkToDB(fileid,$0C); + END ELSE BEGIN + END; + END; +PROCEDURE IGHH(fileid:LongWord; dir_dat2db:Boolean); + BEGIN + IF dir_dat2db THEN BEGIN + InsertDatLinkToDB(fileid,$24); + InsertDatLinkToDB(fileid,$28); + END ELSE BEGIN + END; + END; +PROCEDURE IGPA(fileid:LongWord; dir_dat2db:Boolean); + VAR + links:LongWord; + i:LongWord; + BEGIN + IF dir_dat2db THEN BEGIN + LoadFilePart($1C,4,@links); + IF links>0 THEN + FOR i:=0 TO links-1 DO InsertDatLinkToDB(fileid,$20+i*4); + END ELSE BEGIN + END; + END; +PROCEDURE IGPG(fileid:LongWord; dir_dat2db:Boolean); + VAR + i:LongWord; + BEGIN + IF dir_dat2db THEN BEGIN + FOR i:=0 TO 1 DO InsertDatLinkToDB(fileid,$1C+i*4); + END ELSE BEGIN + END; + END; +PROCEDURE IGSA(fileid:LongWord; dir_dat2db:Boolean); + VAR + links:LongWord; + i:LongWord; + BEGIN + IF dir_dat2db THEN BEGIN + LoadFilePart($1C,4,@links); + IF links>0 THEN + FOR i:=0 TO links-1 DO InsertDatLinkToDB(fileid,$20+i*4); + END ELSE BEGIN + END; + END; +PROCEDURE IMPT(fileid:LongWord; dir_dat2db:Boolean); + BEGIN + IF dir_dat2db THEN BEGIN + InsertDatLinkToDB(fileid,$10); + END ELSE BEGIN + END; + END; +PROCEDURE IPGE(fileid:LongWord; dir_dat2db:Boolean); + BEGIN + IF dir_dat2db THEN BEGIN + InsertDatLinkToDB(fileid,$0C); + END ELSE BEGIN + END; + END; +PROCEDURE KEYI(fileid:LongWord; dir_dat2db:Boolean); + VAR + i:LongWord; + BEGIN + IF dir_dat2db THEN BEGIN + FOR i:=0 TO 9 DO InsertDatLinkToDB(fileid,$08+i*4); + END ELSE BEGIN + END; + END; +PROCEDURE M3GA(fileid:LongWord; dir_dat2db:Boolean); + VAR + links:LongWord; + i:LongWord; + BEGIN + IF dir_dat2db THEN BEGIN + LoadFilePart($1C,4,@links); + IF links>0 THEN + FOR i:=0 TO links-1 DO InsertDatLinkToDB(fileid,$20+i*4); + END ELSE BEGIN + END; + END; +PROCEDURE M3GM(fileid:LongWord; dir_dat2db:Boolean); + VAR + i:LongWord; + BEGIN + IF dir_dat2db THEN BEGIN + FOR i:=0 TO 6 DO InsertDatLinkToDB(fileid,$0C+i*4); + END ELSE BEGIN + END; + END; +PROCEDURE MTRL(fileid:LongWord; dir_dat2db:Boolean); + BEGIN + IF dir_dat2db THEN BEGIN + InsertDatLinkToDB(fileid,$10); + END ELSE BEGIN + END; + END; +PROCEDURE OBOA(fileid:LongWord; dir_dat2db:Boolean); + VAR + packages:Word; + i:LongWord; + BEGIN + IF dir_dat2db THEN BEGIN + LoadFilePart($1E,2,@packages); + IF packages>0 THEN + FOR i:=0 TO packages-1 DO InsertDatLinkToDB(fileid,$20+i*240); + END ELSE BEGIN + END; + END; +PROCEDURE OFGA(fileid:LongWord; dir_dat2db:Boolean); + VAR + packages:LongWord; + i:LongWord; + BEGIN + IF dir_dat2db THEN BEGIN + LoadFilePart($1C,4,@packages); + IF packages>0 THEN + FOR i:=0 TO packages-1 DO InsertDatLinkToDB(fileid,$20+i*12+$04); + END ELSE BEGIN + END; + END; +PROCEDURE ONCC(fileid:LongWord; dir_dat2db:Boolean); + VAR + i:LongWord; + BEGIN + IF dir_dat2db THEN BEGIN + END ELSE BEGIN + END; + END; +PROCEDURE ONCV(fileid:LongWord; dir_dat2db:Boolean); + BEGIN + IF dir_dat2db THEN BEGIN + InsertDatLinkToDB(fileid,$08); + END ELSE BEGIN + END; + END; +PROCEDURE ONLV(fileid:LongWord; dir_dat2db:Boolean); + VAR + i:LongWord; + BEGIN + IF dir_dat2db THEN BEGIN + FOR i:=0 TO 5 DO InsertDatLinkToDB(fileid,$48+i*4); + FOR i:=0 TO 5 DO InsertDatLinkToDB(fileid,$64+i*4); + InsertDatLinkToDB(fileid,$300); + END ELSE BEGIN + END; + END; +PROCEDURE ONOA(fileid:LongWord; dir_dat2db:Boolean); + VAR + packages:LongWord; + i:LongWord; + BEGIN + IF dir_dat2db THEN BEGIN + LoadFilePart($1C,4,@packages); + IF packages>0 THEN + FOR i:=0 TO packages-1 DO InsertDatLinkToDB(fileid,$20+i*8+$04); + END ELSE BEGIN + END; + END; +PROCEDURE ONSK(fileid:LongWord; dir_dat2db:Boolean); + BEGIN + IF dir_dat2db THEN BEGIN + InsertDatLinkToDB(fileid,$08); + InsertDatLinkToDB(fileid,$0C); + InsertDatLinkToDB(fileid,$10); + InsertDatLinkToDB(fileid,$14); + InsertDatLinkToDB(fileid,$18); + InsertDatLinkToDB(fileid,$20); + InsertDatLinkToDB(fileid,$44); + END ELSE BEGIN + END; + END; +PROCEDURE ONVL(fileid:LongWord; dir_dat2db:Boolean); + VAR + packages:LongWord; + i:LongWord; + BEGIN + IF dir_dat2db THEN BEGIN + LoadFilePart($1C,4,@packages); + IF packages>0 THEN + FOR i:=0 TO packages-1 DO InsertDatLinkToDB(fileid,$20+i*4); + END ELSE BEGIN + END; + END; +PROCEDURE ONWC(fileid:LongWord; dir_dat2db:Boolean); + BEGIN + IF dir_dat2db THEN BEGIN + InsertDatLinkToDB(fileid,$28); + InsertDatLinkToDB(fileid,$34); + InsertDatLinkToDB(fileid,$54); + InsertDatLinkToDB(fileid,$58); + InsertDatLinkToDB(fileid,$5C); + InsertDatLinkToDB(fileid,$60); + InsertDatLinkToDB(fileid,$6FC); + InsertDatLinkToDB(fileid,$700); + END ELSE BEGIN + END; + END; +PROCEDURE OPGE(fileid:LongWord; dir_dat2db:Boolean); + BEGIN + IF dir_dat2db THEN BEGIN + InsertDatLinkToDB(fileid,$1C); + END ELSE BEGIN + END; + END; +PROCEDURE OSBD(fileid:LongWord; dir_dat2db:Boolean); + VAR + link:LongWord; + datasize:LongWord; + BEGIN + IF dir_dat2db THEN BEGIN + LoadFilePart($08,4,@datasize); + LoadFilePart($0C,4,@link); + InsertRawFileToDB(fileid,$0C,link,datasize); + END ELSE BEGIN + END; + END; +PROCEDURE PSPC(fileid:LongWord; dir_dat2db:Boolean); + BEGIN + IF dir_dat2db THEN BEGIN + InsertDatLinkToDB(fileid,$50); + END ELSE BEGIN + END; + END; +PROCEDURE PSPL(fileid:LongWord; dir_dat2db:Boolean); + VAR + packages:LongWord; + i:LongWord; + BEGIN + IF dir_dat2db THEN BEGIN + LoadFilePart($1C,4,@packages); + IF packages>0 THEN + FOR i:=0 TO packages-1 DO InsertDatLinkToDB(fileid,$24+i*8); + END ELSE BEGIN + END; + END; +PROCEDURE PSUI(fileid:LongWord; dir_dat2db:Boolean); + VAR + i:LongWord; + BEGIN + IF dir_dat2db THEN BEGIN + FOR i:=0 TO 43 DO InsertDatLinkToDB(fileid,$08+i*4); + END ELSE BEGIN + END; + END; +PROCEDURE SNDD(fileid:LongWord; dir_dat2db:Boolean); + VAR + link:LongWord; + datasize:LongWord; + BEGIN + IF dir_dat2db THEN BEGIN + LoadFilePart($40,4,@datasize); + LoadFilePart($44,4,@link); + InsertRawFileToDB(fileid,$44,link,datasize); + END ELSE BEGIN + END; + END; +PROCEDURE SUBT(fileid:LongWord; dir_dat2db:Boolean); + VAR + baselink,link:LongWord; + links:LongWord; + i,j:LongWord; + data:Tdata; + BEGIN + IF dir_dat2db THEN BEGIN + LoadFilePart($18,4,@baselink); + LoadFilePart($1C,4,@links); + IF links>0 THEN BEGIN + FOR i:=0 TO links-1 DO BEGIN + LoadFilePart($20+i*4,4,@link); + SetLength(data,1024); + LoadRawFile(fileid,baselink+link,1024,@data[0]); + FOR j:=0 TO 1024 DO BEGIN + IF (data[j]=$00) OR (j=1024) THEN BEGIN + IF j<1024 THEN + InsertRawFileToDB(fileid,$20+i*4,baselink+link,j) + ELSE + ShowMessage('Error: Didn''t find message-end-marker...'); + Break; + END; + END; + END; + END; + END ELSE BEGIN + END; + END; +PROCEDURE STNA(fileid:LongWord; dir_dat2db:Boolean); + VAR + packages:Word; + i:LongWord; + BEGIN + IF dir_dat2db THEN BEGIN + LoadFilePart($1E,2,@packages); + IF packages>0 THEN + FOR i:=0 TO packages-1 DO InsertDatLinkToDB(fileid,$20+i*4); + END ELSE BEGIN + END; + END; +PROCEDURE TRAC(fileid:LongWord; dir_dat2db:Boolean); + VAR + packages:Word; + i:LongWord; + BEGIN + IF dir_dat2db THEN BEGIN + InsertDatLinkToDB(fileid,$18); + LoadFilePart($1E,2,@packages); + IF packages>0 THEN + FOR i:=0 TO packages-1 DO InsertDatLinkToDB(fileid,$20+i*12+8); + END ELSE BEGIN + END; + END; +PROCEDURE TRAM(fileid:LongWord; dir_dat2db:Boolean); + VAR + i:Byte; + link:LongWord; + BEGIN + IF dir_dat2db THEN BEGIN + FOR i:=0 TO 11 DO BEGIN + LoadFilePart($0C+i*4,4,@link); + InsertRawFileToDB(fileid,$0C+i*4,link,1{????????????????????????????????}); + END; + LoadFilePart($13C,4,@link); + InsertRawFileToDB(fileid,$13C,link,1{????????????????????????????????}); + END ELSE BEGIN + END; + END; +PROCEDURE TRAS(fileid:LongWord; dir_dat2db:Boolean); + BEGIN + IF dir_dat2db THEN BEGIN + InsertDatLinkToDB(fileid,$08); + END ELSE BEGIN + END; + END; +PROCEDURE TRBS(fileid:LongWord; dir_dat2db:Boolean); + VAR + i:LongWord; + BEGIN + IF dir_dat2db THEN BEGIN + FOR i:=0 TO 4 DO InsertDatLinkToDB(fileid,$08+i*4); + END ELSE BEGIN + END; + END; +PROCEDURE TRCM(fileid:LongWord; dir_dat2db:Boolean); + VAR + i:LongWord; + BEGIN + IF dir_dat2db THEN BEGIN + FOR i:=0 TO 2 DO InsertDatLinkToDB(fileid,$5C+i*4); + END ELSE BEGIN + END; + END; +PROCEDURE TRGA(fileid:LongWord; dir_dat2db:Boolean); + VAR + i:LongWord; + packages:Word; + BEGIN + IF dir_dat2db THEN BEGIN + LoadFilePart($1E,2,@packages); + IF packages>0 THEN + FOR i:=0 TO packages-1 DO InsertDatLinkToDB(fileid,$20+i*4); + END ELSE BEGIN + END; + END; +PROCEDURE TRGE(fileid:LongWord; dir_dat2db:Boolean); + BEGIN + IF dir_dat2db THEN BEGIN + InsertDatLinkToDB(fileid,$20); + END ELSE BEGIN + END; + END; +PROCEDURE TRIG(fileid:LongWord; dir_dat2db:Boolean); + BEGIN + IF dir_dat2db THEN BEGIN + InsertDatLinkToDB(fileid,$18); + InsertDatLinkToDB(fileid,$24); + InsertDatLinkToDB(fileid,$28); + END ELSE BEGIN + END; + END; +PROCEDURE TRMA(fileid:LongWord; dir_dat2db:Boolean); + VAR + i:LongWord; + packages:Word; + BEGIN + IF dir_dat2db THEN BEGIN + LoadFilePart($1E,2,@packages); + IF packages>0 THEN + FOR i:=0 TO packages-1 DO InsertDatLinkToDB(fileid,$20+i*4); + END ELSE BEGIN + END; + END; +PROCEDURE TRSC(fileid:LongWord; dir_dat2db:Boolean); + VAR + i:LongWord; + packages:Word; + BEGIN + IF dir_dat2db THEN BEGIN + LoadFilePart($1E,2,@packages); + IF packages>0 THEN + FOR i:=0 TO packages-1 DO InsertDatLinkToDB(fileid,$20+i*4); + END ELSE BEGIN + END; + END; +PROCEDURE TSFF(fileid:LongWord; dir_dat2db:Boolean); + VAR + i:LongWord; + packages:LongWord; + BEGIN + IF dir_dat2db THEN BEGIN + LoadFilePart($1C,4,@packages); + IF packages>0 THEN + FOR i:=0 TO packages-1 DO InsertDatLinkToDB(fileid,$20+i*4); + END ELSE BEGIN + END; + END; +PROCEDURE TSFT(fileid:LongWord; dir_dat2db:Boolean); + BEGIN + IF dir_dat2db THEN BEGIN + InsertDatLinkToDB(fileid,$1C); + END ELSE BEGIN + END; + END; +PROCEDURE TURR(fileid:LongWord; dir_dat2db:Boolean); + BEGIN + IF dir_dat2db THEN BEGIN + InsertDatLinkToDB(fileid,$60); + InsertDatLinkToDB(fileid,$6C); + InsertDatLinkToDB(fileid,$74); + END ELSE BEGIN + END; + END; +PROCEDURE TXAN(fileid:LongWord; dir_dat2db:Boolean); + VAR + i:LongWord; + packages:LongWord; + BEGIN + IF dir_dat2db THEN BEGIN + LoadFilePart($1C,4,@packages); + IF packages>0 THEN + FOR i:=0 TO packages-1 DO InsertDatLinkToDB(fileid,$20+i*4); + END ELSE BEGIN + END; + END; +PROCEDURE TXMA(fileid:LongWord; dir_dat2db:Boolean); + VAR + i:LongWord; + packages:LongWord; + BEGIN + IF dir_dat2db THEN BEGIN + LoadFilePart($1C,4,@packages); + IF packages>0 THEN + FOR i:=0 TO packages-1 DO InsertDatLinkToDB(fileid,$20+i*4); + END ELSE BEGIN + END; + END; +PROCEDURE TXMB(fileid:LongWord; dir_dat2db:Boolean); + VAR + i:LongWord; + packages:LongWord; + BEGIN + IF dir_dat2db THEN BEGIN + LoadFilePart($1C,4,@packages); + IF packages>0 THEN + FOR i:=0 TO packages-1 DO InsertDatLinkToDB(fileid,$20+i*4); + END ELSE BEGIN + END; + END; +PROCEDURE TXMP(fileid:LongWord; dir_dat2db:Boolean); + VAR + link:LongWord; + x,y:Word; + storetype:Byte; + datasize:LongWord; + BEGIN + IF dir_dat2db THEN BEGIN + LoadFilePart($8C,SizeOf(x),@x); + LoadFilePart($8E,SizeOf(y),@y); + LoadFilePart($90,SizeOf(storetype),@storetype); + LoadFilePart($9C,4,@link); + CASE storetype OF + 0,1,2: datasize:=x*y*2; + 8: datasize:=x*y*4; + 9: datasize:=x*y DIV 2; + END; + InsertRawFileToDB(fileid,$9C,link,datasize); + InsertDatLinkToDB(fileid,$94); + InsertDatLinkToDB(fileid,$98); + END ELSE BEGIN + END; + END; +PROCEDURE TXTC(fileid:LongWord; dir_dat2db:Boolean); + BEGIN + IF dir_dat2db THEN BEGIN + InsertDatLinkToDB(fileid,$08); + END ELSE BEGIN + END; + END; +PROCEDURE WMCL(fileid:LongWord; dir_dat2db:Boolean); + BEGIN + IF dir_dat2db THEN BEGIN + InsertDatLinkToDB(fileid,$24); + END ELSE BEGIN + END; + END; +PROCEDURE WMMB(fileid:LongWord; dir_dat2db:Boolean); + VAR + i:LongWord; + packages:LongWord; + BEGIN + IF dir_dat2db THEN BEGIN + LoadFilePart($1C,4,@packages); + IF packages>0 THEN + FOR i:=0 TO packages-1 DO InsertDatLinkToDB(fileid,$20+i*4); + END ELSE BEGIN + END; + END; +PROCEDURE WPGE(fileid:LongWord; dir_dat2db:Boolean); + BEGIN + IF dir_dat2db THEN BEGIN + InsertDatLinkToDB(fileid,$08); + InsertDatLinkToDB(fileid,$0C); + END ELSE BEGIN + END; + END; + +PROCEDURE InsertHandler(ext:String; needed:Boolean; handler:THandler); + BEGIN + SetLength(ConvertHandlers,Length(ConvertHandlers)+1); + ConvertHandlers[High(ConvertHandlers)].Ext:=ext; + ConvertHandlers[High(ConvertHandlers)].needed:=needed; + ConvertHandlers[High(ConvertHandlers)].handler:=handler; + END; + +BEGIN + InsertHandler('ABNA',False,NIL); +// InsertHandler('AGDB',True,AGDB); + InsertHandler('AGDB',False,NIL); + InsertHandler('AGQC',False,NIL); + InsertHandler('AGQG',False,NIL); + InsertHandler('AGQR',False,NIL); + InsertHandler('AISA',False,NIL); + InsertHandler('AITR',False,NIL); + InsertHandler('AKAA',False,NIL); + InsertHandler('AKBA',False,NIL); + InsertHandler('AKBP',False,NIL); + InsertHandler('AKDA',False,NIL); + InsertHandler('AKEV',True,AKEV); + InsertHandler('AKOT',True,AKOT); + InsertHandler('AKVA',False,NIL); + InsertHandler('BINA',True,BINA); + InsertHandler('CBPI',True,CBPI); + InsertHandler('CBPM',True,CBPM); + InsertHandler('CONS',True,CONS); + InsertHandler('CRSA',True,CRSA); + InsertHandler('DOOR',True,DOOR); + InsertHandler('DPGE',True,DPGE); + InsertHandler('ENVP',False,NIL); + InsertHandler('FILM',False,NIL); + InsertHandler('HPGE',True,HPGE); + InsertHandler('IDXA',False,NIL); + InsertHandler('IGHH',True,IGHH); + InsertHandler('IGPA',True,IGPA); + InsertHandler('IGPG',True,IGPG); + InsertHandler('IGSA',True,IGSA); + InsertHandler('IMPT',True,IMPT); + InsertHandler('IPGE',True,IPGE); + InsertHandler('KEYI',True,KEYI); + InsertHandler('M3GA',True,M3GA); + InsertHandler('M3GM',True,M3GM); + InsertHandler('MTRL',True,MTRL); + InsertHandler('OBAN',False,NIL); + InsertHandler('OBDC',False,NIL); + InsertHandler('OBOA',True,OBOA); + InsertHandler('OFGA',True,OFGA); + InsertHandler('ONCC',True,ONCC); + InsertHandler('ONCP',False,NIL); + InsertHandler('ONCV',True,ONCV); + InsertHandler('ONFA',False,NIL); + InsertHandler('ONGS',False,NIL); + InsertHandler('ONIA',False,NIL); + InsertHandler('ONLD',False,NIL); + InsertHandler('ONLV',True,ONLV); + InsertHandler('ONMA',False,NIL); + InsertHandler('ONOA',True,ONOA); + InsertHandler('ONSA',False,NIL); + InsertHandler('ONSK',True,ONSK); + InsertHandler('ONTA',False,NIL); + InsertHandler('ONVL',True,ONVL); + InsertHandler('ONWC',True,ONWC); + InsertHandler('OPGE',True,OPGE); + InsertHandler('OSBD',True,OSBD); + InsertHandler('OTIT',False,NIL); + InsertHandler('OTLF',False,NIL); + InsertHandler('PLEA',False,NIL); + InsertHandler('PNTA',False,NIL); + InsertHandler('PSPC',True,PSPC); + InsertHandler('PSPL',True,PSPL); + InsertHandler('PSUI',True,PSUI); + InsertHandler('QTNA',False,NIL); + InsertHandler('SNDD',True,SNDD); + InsertHandler('STNA',True,STNA); + InsertHandler('SUBT',True,SUBT); + InsertHandler('TRAC',True,TRAC); + InsertHandler('TRAM',True,TRAM); + InsertHandler('TRAS',True,TRAS); + InsertHandler('TRBS',True,TRBS); + InsertHandler('TRCM',True,TRCM); + InsertHandler('TRGA',True,TRGA); + InsertHandler('TRGE',True,TRGE); + InsertHandler('TRIA',False,NIL); + InsertHandler('TRIG',True,TRIG); + InsertHandler('TRMA',True,TRMA); + InsertHandler('TRSC',True,TRSC); + InsertHandler('TRTA',False,NIL); + InsertHandler('TSFF',True,TSFF); + InsertHandler('TSFL',False,NIL); + InsertHandler('TSFT',True,TSFT); + InsertHandler('TSGA',False,NIL); + InsertHandler('TSTR',False,NIL); + InsertHandler('TURR',True,TURR); + InsertHandler('TXAN',True,TXAN); + InsertHandler('TXCA',False,NIL); + InsertHandler('TXMA',True,TXMA); + InsertHandler('TXMB',True,TXMB); + InsertHandler('TXMP',True,TXMP); + InsertHandler('TXTC',True,TXTC); + InsertHandler('VCRA',False,NIL); + InsertHandler('WMCL',True,WMCL); + InsertHandler('WMDD',False,NIL); + InsertHandler('WMM_',False,NIL); + InsertHandler('WMMB',True,WMMB); + InsertHandler('WPGE',True,WPGE); +END. Index: /oup/releases/0.20a/Unit11_extractor.dfm =================================================================== --- /oup/releases/0.20a/Unit11_extractor.dfm (revision 21) +++ /oup/releases/0.20a/Unit11_extractor.dfm (revision 21) @@ -0,0 +1,223 @@ +object Form11: TForm11 + Left = 0 + Top = 0 + Width = 495 + Height = 425 + Caption = 'Extractor' + Color = clBtnFace + Font.Charset = DEFAULT_CHARSET + Font.Color = clWindowText + Font.Height = -11 + Font.Name = 'Tahoma' + Font.Style = [] + FormStyle = fsMDIChild + OldCreateOrder = False + Visible = True + WindowState = wsMaximized + OnActivate = FormActivate + OnClose = FormClose + OnCreate = FormCreate + OnResize = FormResize + PixelsPerInch = 96 + TextHeight = 13 + object group_select: TGroupBox + Left = 0 + Top = 0 + Width = 191 + Height = 398 + Align = alClient + Caption = '1. Select file(s)' + TabOrder = 0 + object panel_extension: TPanel + Left = 2 + Top = 371 + Width = 187 + Height = 25 + Align = alBottom + BevelOuter = bvNone + TabOrder = 1 + OnResize = panel_extensionResize + object combo_extension: TComboBox + Left = 2 + Top = 2 + Width = 183 + Height = 21 + Style = csDropDownList + DropDownCount = 12 + Font.Charset = DEFAULT_CHARSET + Font.Color = clWindowText + Font.Height = -11 + Font.Name = 'Tahoma' + Font.Style = [] + ItemHeight = 13 + ParentFont = False + Sorted = True + TabOrder = 0 + OnClick = combo_extensionClick + end + end + object list: TListBox + Left = 2 + Top = 15 + Width = 187 + Height = 356 + Align = alClient + ItemHeight = 13 + MultiSelect = True + TabOrder = 0 + end + end + object group_extract: TGroupBox + Left = 191 + Top = 0 + Width = 296 + Height = 398 + Align = alRight + Caption = '2. Select extract-method' + TabOrder = 1 + object group_singlefiles: TGroupBox + Left = 8 + Top = 16 + Width = 281 + Height = 185 + Caption = 'Write data into single files' + TabOrder = 0 + object btn_sel_dat: TButton + Left = 8 + Top = 16 + Width = 129 + Height = 49 + Caption = 'Selected files (dat contents only)' + TabOrder = 0 + WordWrap = True + OnClick = Extract + end + object btn_sel_datraw: TButton + Left = 8 + Top = 72 + Width = 129 + Height = 49 + Caption = 'Selected files (dat+raw)' + TabOrder = 1 + WordWrap = True + OnClick = Extract + end + object btn_sel_datraw_convert: TButton + Left = 8 + Top = 128 + Width = 129 + Height = 49 + Caption = 'Selected files (dat+raw) (with convert if possible)' + TabOrder = 2 + WordWrap = True + OnClick = Extract + end + object btn_all_dat: TButton + Left = 144 + Top = 16 + Width = 129 + Height = 49 + Caption = 'All files in list (dat contents only)' + TabOrder = 3 + WordWrap = True + OnClick = Extract + end + object btn_all_datraw: TButton + Left = 144 + Top = 72 + Width = 129 + Height = 49 + Caption = 'All files in list (dat+raw)' + TabOrder = 4 + WordWrap = True + OnClick = Extract + end + object btn_all_datraw_convert: TButton + Left = 144 + Top = 128 + Width = 129 + Height = 49 + BiDiMode = bdLeftToRight + Caption = 'All files in list (dat+raw) (with convert if possible)' + ParentBiDiMode = False + TabOrder = 5 + WordWrap = True + OnClick = Extract + end + end + object group_onefile: TGroupBox + Left = 8 + Top = 208 + Width = 281 + Height = 73 + Caption = 'Write data into one file' + TabOrder = 1 + object btn_sel_files_toone: TButton + Left = 8 + Top = 16 + Width = 129 + Height = 49 + Caption = 'Selected files (dat contents only)' + TabOrder = 0 + WordWrap = True + OnClick = Extract + end + object btn_all_files_toone: TButton + Left = 144 + Top = 16 + Width = 129 + Height = 49 + Caption = 'All files in list (dat contents only)' + TabOrder = 1 + WordWrap = True + OnClick = Extract + end + end + object group_progress: TGroupBox + Left = 8 + Top = 288 + Width = 281 + Height = 105 + Caption = 'Progress ...' + TabOrder = 2 + Visible = False + object lbl_progress: TLabel + Left = 8 + Top = 40 + Width = 265 + Height = 17 + AutoSize = False + Caption = 'Files done: 0/0' + end + object lbl_estimated: TLabel + Left = 8 + Top = 56 + Width = 265 + Height = 17 + AutoSize = False + Caption = 'Estimated finishing time: 00:00:00' + end + object progress: TProgressBar + Left = 8 + Top = 16 + Width = 265 + Height = 17 + Smooth = True + TabOrder = 0 + end + object btn_abort: TButton + Left = 8 + Top = 72 + Width = 97 + Height = 23 + Caption = 'Abort' + Enabled = False + TabOrder = 1 + end + end + end + object saved: TSaveDialog + Left = 448 + Top = 328 + end +end Index: /oup/releases/0.20a/Unit11_extractor.pas =================================================================== --- /oup/releases/0.20a/Unit11_extractor.pas (revision 21) +++ /oup/releases/0.20a/Unit11_extractor.pas (revision 21) @@ -0,0 +1,184 @@ +UNIT Unit11_extractor; +INTERFACE +USES + Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, + Dialogs, StdCtrls, ExtCtrls, StrUtils, ComCtrls; +TYPE + TForm11 = Class(TForm) + group_select: TGroupBox; + panel_extension: TPanel; + combo_extension: TComboBox; + list: TListBox; + group_extract: TGroupBox; + group_singlefiles: TGroupBox; + btn_sel_dat: TButton; + btn_sel_datraw: TButton; + btn_sel_datraw_convert: TButton; + btn_all_dat: TButton; + btn_all_datraw: TButton; + btn_all_datraw_convert: TButton; + group_onefile: TGroupBox; + btn_sel_files_toone: TButton; + btn_all_files_toone: TButton; + group_progress: TGroupBox; + progress: TProgressBar; + lbl_progress: TLabel; + lbl_estimated: TLabel; + btn_abort: TButton; + saved: TSaveDialog; + PROCEDURE FormCreate(Sender: TObject); + PROCEDURE FormActivate(Sender: TObject); + PROCEDURE FormClose(Sender: TObject; var Action: TCloseAction); + PROCEDURE FormResize(Sender: TObject); + PROCEDURE combo_extensionClick(Sender: TObject); + PROCEDURE panel_extensionResize(Sender: TObject); + PROCEDURE Extract(Sender: TObject); + PRIVATE + PUBLIC + PROCEDURE Recreatelist; + END; + +VAR + Form11: TForm11; + +IMPLEMENTATION +{$R *.dfm} +USES Unit1_main, Unit2_functions, Unit3_data; + +PROCEDURE TForm11.Recreatelist; + VAR + i:LongWord; + exts:TStringList; + BEGIN + combo_extension.Items.Clear; + combo_extension.Items.Add('_All files_ ('{+IntToStr(dat_header.Files)}+')'); + exts:=GetExtensionsList; + FOR i:=0 TO High(exts) DO + combo_extension.Items.Add(exts[i]); + combo_extension.ItemIndex:=0; + combo_extensionClick(Self); + END; + +PROCEDURE TForm11.panel_extensionResize(Sender: TObject); + BEGIN + combo_extension.Width:=panel_extension.Width-5; + END; + +PROCEDURE TForm11.combo_extensionClick(Sender: TObject); + VAR + Extension:String[4]; + files:TStringList; + i:LongWord; + BEGIN + Extension:=MidStr(combo_extension.Items.Strings[combo_extension.ItemIndex],1,4); + list.Items.Clear; + IF Extension='_All' THEN + files:=GetFilesList('','',True) + ELSE + files:=GetFilesList(extension,'',True); + IF Length(files)>0 THEN + FOR i:=0 TO High(files) DO + list.Items.Add(files[i]); + END; + +PROCEDURE TForm11.FormResize(Sender: TObject); + BEGIN + IF Self.Width>=450 THEN BEGIN + END ELSE Self.Width:=450; + IF Self.Height>=400 THEN BEGIN + group_progress.Height:=group_extract.Height-293; + END ELSE Self.Height:=400; + END; + +PROCEDURE TForm11.FormClose(Sender: TObject; var Action: TCloseAction); + BEGIN + Action:=caFree; + Form1.close_window(Self.Name); + END; + +PROCEDURE TForm11.FormActivate(Sender: TObject); + BEGIN + Form1.SetActiveWindow(Self.Name); + END; + +PROCEDURE TForm11.FormCreate(Sender: TObject); + BEGIN + btn_sel_dat.Caption:= 'Selected files'+CrLf+'(dat contents only)'; + btn_sel_datraw.Caption:= 'Selected files'+CrLf+'(dat+raw contents)'; + btn_sel_datraw_convert.Caption:='Selected files'+CrLf+'(dat+raw contents)'+CrLf+'(with convert if possible)'; + btn_all_dat.Caption:= 'All files in list'+CrLf+'(dat contents only)'; + btn_all_datraw.Caption:= 'All files in list'+CrLf+'(dat+raw contents)'; + btn_all_datraw_convert.Caption:='All files in list'+CrLf+'(dat+raw contents)'+CrLf+'(with convert if possible)'; + btn_sel_files_toone.Caption:= 'Selected files'+CrLf+'(dat contents only)'; + btn_all_files_toone.Caption:= 'All files in list'+CrLf+'(dat contents only)'; + END; + +PROCEDURE TForm11.Extract(Sender: TObject); + VAR + sel_only:Boolean; + dat_only:Boolean; + convert:Boolean; + one_file:Boolean; + settings:TExportSet; + files:LongWord; + i,done:LongWord; + begintime:Double; + BEGIN + sel_only:=Pos('sel',TButton(Sender).Name)>0; + dat_only:=NOT (Pos('datraw',TButton(Sender).Name)>0); + convert:=Pos('convert',TButton(Sender).Name)>0; + one_file:=Pos('toone',TButton(Sender).Name)>0; + IF dat_only THEN settings:=[DO_dat] + ELSE settings:=[DO_dat,DO_raw]; + IF convert THEN settings:=settings+[DO_convert]; + IF one_file THEN settings:=settings+[DO_toone]; + progress.Position:=0; + + IF saved.Execute THEN BEGIN + begintime:=Time; + group_progress.Visible:=True; + group_select.Enabled:=False; + group_singlefiles.Enabled:=False; + group_onefile.Enabled:=False; + lbl_estimated.Caption:='Estimated finishing time: unknown'; + IF sel_only THEN BEGIN + files:=list.SelCount; + lbl_progress.Caption:='Files done: 0/'+IntToStr(files); + progress.Max:=files; + done:=0; + FOR i:=0 TO list.Count-1 DO BEGIN + IF list.Selected[i] THEN BEGIN + ExportFile(StrToInt(MidStr(list.Items.Strings[i],1,5)),list.Items.Strings[i],settings,'D:'); + Inc(done); + END; + IF ((done MOD 10)=0) AND (done>=50) THEN + lbl_estimated.Caption:='Estimated finishing time: '+TimeToStr((Time-begintime)/done*files+begintime); + IF (i MOD 10)=0 THEN BEGIN + progress.Position:=done; + lbl_progress.Caption:='Files done: '+IntToStr(done)+'/'+IntToStr(files); + Application.ProcessMessages; + END; + END; + END ELSE BEGIN + files:=list.Count; + lbl_progress.Caption:='Files done: 0/'+IntToStr(files); + progress.Max:=files; + FOR i:=0 TO list.Count-1 DO BEGIN + ExportFile(StrToInt(MidStr(list.Items.Strings[i],1,5)),list.Items.Strings[i],settings,'D:'); + IF ((i MOD 10)=0) AND (i>=50) THEN + lbl_estimated.Caption:='Estimated finishing time: '+TimeToStr((Time-begintime)/i*files+begintime); + IF (i MOD 5)=0 THEN BEGIN + progress.Position:=done; + lbl_progress.Caption:='Files done: '+IntToStr(done)+'/'+IntToStr(files); + Application.ProcessMessages; + END; + END; + END; + group_progress.Visible:=False; + group_select.Enabled:=True; + group_singlefiles.Enabled:=True; + group_onefile.Enabled:=True; + END; + END; + +END. Index: /oup/releases/0.20a/Unit1_main.dfm =================================================================== --- /oup/releases/0.20a/Unit1_main.dfm (revision 21) +++ /oup/releases/0.20a/Unit1_main.dfm (revision 21) @@ -0,0 +1,167 @@ +object Form1: TForm1 + Left = 0 + Top = 0 + HorzScrollBar.Visible = False + VertScrollBar.Visible = False + AutoScroll = False + Caption = 'Form1' + ClientHeight = 544 + ClientWidth = 692 + Color = clBtnFace + Font.Charset = DEFAULT_CHARSET + Font.Color = clWindowText + Font.Height = -11 + Font.Name = 'Tahoma' + Font.Style = [] + FormStyle = fsMDIForm + Menu = menu + OldCreateOrder = False + OnClose = FormClose + OnCreate = FormCreate + OnResize = FormResize + PixelsPerInch = 96 + TextHeight = 13 + object statbar: TStatusBar + Left = 0 + Top = 527 + Width = 692 + Height = 17 + BiDiMode = bdLeftToRight + Panels = < + item + Text = 'Nothing loaded' + Width = 500 + end + item + Text = 'Files: -' + Width = 90 + end + item + Text = 'Extensions: -' + Width = 100 + end> + ParentBiDiMode = False + end + object tabs: TTabSet + Left = 0 + Top = 507 + Width = 692 + Height = 20 + Align = alBottom + DitherBackground = False + Font.Charset = DEFAULT_CHARSET + Font.Color = clWindowText + Font.Height = -11 + Font.Name = 'Tahoma' + Font.Style = [] + SoftTop = True + Style = tsModernTabs + OnChange = tabsChange + end + object opend: TOpenDialog + Options = [ofPathMustExist, ofFileMustExist, ofEnableSizing] + Left = 480 + end + object menu: TMainMenu + AutoHotkeys = maManual + Left = 592 + object menu_main: TMenuItem + Caption = '&Main' + object menu_loaddat: TMenuItem + Caption = '&Select .dat-file ...' + ShortCut = 16463 + OnClick = menu_loaddatClick + end + object menu_lvldb: TMenuItem + Caption = 'Open OUP-Level-&DB ...' + ShortCut = 16452 + OnClick = menu_lvldbClick + end + object menu_sep1: TMenuItem + Caption = '-' + end + object menu_exit: TMenuItem + Caption = '&Exit' + OnClick = menu_exitClick + end + end + object menu_convert: TMenuItem + Caption = '&Convert' + Enabled = False + object menu_createdb: TMenuItem + Caption = 'Create level-database' + Enabled = False + OnClick = menu_createdbClick + end + object menu_createlvl: TMenuItem + Caption = 'Create level-files' + Enabled = False + OnClick = menu_createlvlClick + end + end + object menu_tools: TMenuItem + Caption = '&Tools' + Enabled = False + object menu_preview: TMenuItem + Caption = '&Preview Window ...' + ShortCut = 16464 + OnClick = menu_previewClick + end + object menu_binedit: TMenuItem + Caption = '&Binary .dat editor ...' + ShortCut = 16450 + OnClick = menu_bineditClick + end + object menu_txmpreplace: TMenuItem + Caption = '&TXMP replacer ...' + ShortCut = 16468 + OnClick = menu_txmpreplaceClick + end + object menu_extractor: TMenuItem + Caption = 'File &extractor ...' + ShortCut = 16453 + OnClick = menu_extractorClick + end + object menu_levelstructedit: TMenuItem + Caption = 'Levelfile structure editor ...' + Enabled = False + ShortCut = 16460 + end + end + object menu_windows: TMenuItem + Caption = '&Windows' + object menu_windows_cascade: TMenuItem + Caption = 'Cascade' + OnClick = menu_windows_cascadeClick + end + object menu_windows_tile: TMenuItem + Caption = 'Tile' + OnClick = menu_windows_tileClick + end + object menu_windows_closeall: TMenuItem + Caption = '&Close all' + OnClick = menu_windows_closeallClick + end + object menu_sep3: TMenuItem + Caption = '-' + end + object menu_windows_next: TMenuItem + Caption = 'Next window' + ShortCut = 16417 + OnClick = menu_windows_nextClick + end + object menu_windows_previous: TMenuItem + Caption = 'Previous window' + ShortCut = 16418 + OnClick = menu_windows_previousClick + end + object menu_sep2: TMenuItem + Caption = '-' + end + end + end + object saved: TSaveDialog + Options = [ofOverwritePrompt, ofPathMustExist, ofEnableSizing] + Left = 520 + end +end Index: /oup/releases/0.20a/Unit1_main.pas =================================================================== --- /oup/releases/0.20a/Unit1_main.pas (revision 21) +++ /oup/releases/0.20a/Unit1_main.pas (revision 21) @@ -0,0 +1,434 @@ +UNIT Unit1_main; +INTERFACE +USES + Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, + Dialogs, StdCtrls, StrUtils, Clipbrd, ExtCtrls, ComCtrls, Menus, Grids, + MPHexEditor, ToolWin, ImgList, Tabs, + Unit2_functions, Unit3_data, + Unit10_leveldb, +Unit4_exporters, + Unit5_preview, Unit7_txmpreplace, Unit8_binedit, Unit11_extractor; + +TYPE + TForm1 = Class(TForm) + tabs: TTabSet; + saved: TSaveDialog; + opend: TOpenDialog; + statbar: TStatusBar; + menu: TMainMenu; + menu_main: TMenuItem; + menu_loaddat: TMenuItem; + menu_lvldb: TMenuItem; + menu_exit: TMenuItem; + menu_convert: TMenuItem; + menu_createdb: TMenuItem; + menu_createlvl: TMenuItem; + menu_tools: TMenuItem; + menu_preview: TMenuItem; + menu_txmpreplace: TMenuItem; + menu_binedit: TMenuItem; + menu_extractor: TMenuItem; + menu_windows: TMenuItem; + menu_windows_cascade: TMenuItem; + menu_windows_tile: TMenuItem; + menu_windows_closeall: TMenuItem; + menu_windows_next: TMenuItem; + menu_windows_previous: TMenuItem; + menu_sep1: TMenuItem; + menu_sep2: TMenuItem; + menu_sep3: TMenuItem; + menu_levelstructedit: TMenuItem; + PROCEDURE menu_createlvlClick(Sender: TObject); + PROCEDURE menu_extractorClick(Sender: TObject); + PROCEDURE menu_lvldbClick(Sender: TObject); + PROCEDURE menu_createdbClick(Sender: TObject); + PROCEDURE SetActiveWindow(window_name:String); + PROCEDURE tabsChange(Sender: TObject; NewTab: Integer; var AllowChange: Boolean); + PROCEDURE close_window(window_name:String); + PROCEDURE menu_windows_previousClick(Sender: TObject); + PROCEDURE menu_windows_nextClick(Sender: TObject); + PROCEDURE menu_windows_tileClick(Sender: TObject); + PROCEDURE open_child(window_context:String); + PROCEDURE menu_windows_closeallClick(Sender: TObject); + PROCEDURE menu_windows_cascadeClick(Sender: TObject); + PROCEDURE menu_window_entryClick(Sender: TObject); + PROCEDURE menu_bineditClick(Sender: TObject); + PROCEDURE menu_loaddatClick(Sender: TObject); + PROCEDURE menu_txmpreplaceClick(Sender: TObject); + PROCEDURE menu_exitClick(Sender: TObject); + PROCEDURE menu_previewClick(Sender: TObject); + PROCEDURE FormClose(Sender: TObject; var Action: TCloseAction); + PROCEDURE FormResize(Sender: TObject); + PROCEDURE FormCreate(Sender: TObject); + PRIVATE + PUBLIC + END; + +VAR + Form1: TForm1; + +IMPLEMENTATION +{$R *.dfm} +VAR + tablist:Array OF String; + +PROCEDURE TForm1.FormCreate(Sender: TObject); + BEGIN + Form1.Caption:='Oni Un/Packer '+version; + Form1.FormResize(Form1); + + IF FileExists(ExtractFilepath(Application.EXEname)+'\oniunpacker.ini') THEN BEGIN + AssignFile(AppSettingsFile,ExtractFilepath(Application.EXEname)+'\oniunpacker.ini'); + Reset(AppSettingsFile); + Read(AppSettingsFile,AppSettings); + CloseFile(AppSettingsFile); + END ELSE BEGIN + AppSettings.DatPath:='D:\Spiele\Oni\GameDataFolder'; + AppSettings.ExtractPath:='C:\Dokumente und Einstellungen\Administrator\Desktop'; + END; + END; + +PROCEDURE TForm1.FormResize(Sender: TObject); + CONST + MinWidth:Integer=750; + MinHeight:Integer=500; + BEGIN + IF Form1.Width0 THEN BEGIN + FOR i:=0 TO MDIChildCount-1 DO BEGIN + MDIChildren[i].Close; + END; + END; + tabs.Tabs.Clear; + END; +PROCEDURE TForm1.menu_windows_nextClick(Sender: TObject); + VAR i:Byte; + first_window:Byte; + current_focus:String; + BEGIN + IF MDIChildCount>1 THEN BEGIN + FOR i:=0 TO menu_windows.Count-1 DO BEGIN + IF Pos('menu_window_',menu_windows.Items[i].Name)=1 THEN BEGIN + first_window:=i; + Break; + END; + END; + current_focus:=ActiveMDIChild.Name; + FOR i:=first_window TO menu_windows.Count-1 DO + IF Pos(current_focus,menu_windows.Items[i].Name)>0 THEN + Break; + IF i=menu_windows.Count-1 THEN + menu_windows.Items[first_window].Click + ELSE + menu_windows.Items[i+1].Click; + FOR i:=0 TO High(tablist) DO BEGIN + IF tablist[i]=ActiveMDIChild.Name THEN BEGIN + tabs.TabIndex:=i; + END; + END; + END; + END; +PROCEDURE TForm1.menu_windows_previousClick(Sender: TObject); + VAR i:Byte; + first_window:Byte; + current_focus:String; + BEGIN + IF MDIChildCount>1 THEN BEGIN + FOR i:=0 TO menu_windows.Count-1 DO BEGIN + IF Pos('menu_window_',menu_windows.Items[i].Name)=1 THEN BEGIN + first_window:=i; + Break; + END; + END; + current_focus:=ActiveMDIChild.Name; + FOR i:=first_window TO menu_windows.Count-1 DO + IF Pos(current_focus,menu_windows.Items[i].Name)>0 THEN + Break; + IF i=first_window THEN + menu_windows.Items[menu_windows.Count-1].Click + ELSE + menu_windows.Items[i-1].Click; + FOR i:=0 TO High(tablist) DO BEGIN + IF tablist[i]=ActiveMDIChild.Name THEN BEGIN + tabs.TabIndex:=i; + END; + END; + END; + END; + +PROCEDURE TForm1.menu_window_entryClick(Sender: TObject); + VAR + i:Byte; + window_name:String; + BEGIN + window_name:=MidStr(TComponent(Sender).Name,Pos('window_',TComponent(Sender).Name)+7,Length(TComponent(Sender).Name)-Pos('window_',TComponent(Sender).Name)+7+1); + FOR i:=0 TO MDIChildCount-1 DO BEGIN + IF MDIChildren[i].Name=window_name THEN BEGIN + MDIChildren[i].BringToFront; + END; + END; + FOR i:=0 TO High(tablist) DO BEGIN + IF tablist[i]=ActiveMDIChild.Name THEN BEGIN + tabs.TabIndex:=i; + END; + END; + END; + + + +PROCEDURE TForm1.open_child(window_context:String); + VAR + binEdit:TForm8; + preview:TForm5; + txmpreplacer:TForm7; + extractor:TForm11; + menu_button:TMenuItem; + used:Array[1..9] OF Boolean; + i:Byte; + caption:String; + name:String; + BEGIN + FOR i:=1 TO 9 DO used[i]:=False; + IF MDIChildCount>0 THEN + FOR i:=0 TO MDIChildCount-1 DO + IF Pos(window_context,Form1.MDIChildren[i].Name)=1 THEN + used[StrToInt(RightStr(Form1.MDIChildren[i].Caption,1))]:=True; + FOR i:=1 TO 10 DO + IF i=10 THEN + Break + ELSE + IF NOT used[i] THEN Break; + + IF i<10 THEN BEGIN + name:=window_context+IntToStr(i); + IF window_context='binedit' THEN + caption:='Binary .dat-Editor '+IntToStr(i); + IF window_context='preview' THEN + caption:='Preview-Window '+IntToStr(i); + IF window_context='txmpreplace' THEN + caption:='TXMP Replacer '+IntToStr(i); + IF window_context='extractor' THEN + caption:='Extractor '+IntToStr(i); + + menu_button:=TMenuItem.Create(menu_windows); + menu_button.Caption:=caption; + menu_button.Name:='menu_window_'+name; + menu_button.OnClick:=Form1.menu_window_entryClick; + menu_windows.Add(menu_button); + + SetLength(tablist,Length(tablist)+1); + tablist[High(tablist)]:=name; + tabs.Tabs.Add(caption); + + IF window_context='binedit' THEN BEGIN + binEdit:=TForm8.Create(Application); + binEdit.Name:=name; + binEdit.Caption:=caption; + binEdit.Recreatelist; + END; + IF window_context='preview' THEN BEGIN + preview:=TForm5.Create(Application); + preview.Name:=name; + preview.Caption:=caption; + preview.Recreatelist; + END; + IF window_context='txmpreplace' THEN BEGIN + txmpreplacer:=TForm7.Create(Application); + txmpreplacer.Name:=name; + txmpreplacer.Caption:=caption; + txmpreplacer.Recreatelist; + END; + IF window_context='extractor' THEN BEGIN + extractor:=TForm11.Create(Application); + extractor.Name:=name; + extractor.Caption:=caption; + extractor.Recreatelist; + END; + + tabs.TabIndex:=High(tablist); + IF MDIChildCount=9 THEN menu_tools.Enabled:=False; + END; + END; + + +PROCEDURE TForm1.close_window(window_name:String); + VAR + i,j:Byte; + BEGIN + FOR i:=0 TO menu_windows.Count-1 DO BEGIN + IF menu_windows.Items[i].Name='menu_window_'+window_name THEN BEGIN + menu_windows.Items[i].Free; + Break; + END; + END; + FOR i:=0 TO High(tablist) DO BEGIN + IF tablist[i]=window_name THEN BEGIN + tabs.Tabs.Delete(i); + IF High(tablist)>0 THEN + FOR j:=i TO High(tablist)-1 DO + tablist[j]:=tablist[j+1]; + SetLength(tablist,Length(tablist)-1); + Break; + END; + END; + menu_tools.Enabled:=True; + END; + + +PROCEDURE TForm1.tabsChange(Sender: TObject; NewTab: Integer; var AllowChange: Boolean); + VAR + i:Byte; + BEGIN + FOR i:=0 TO MDIChildCount-1 DO BEGIN + IF MDIChildren[i].Name=tablist[NewTab] THEN + MDIChildren[i].BringToFront; + END; + END; + +PROCEDURE TForm1.SetActiveWindow(window_name:String); + VAR + i:Byte; + BEGIN + IF Length(tablist)>0 THEN + FOR i:=0 TO High(tablist) DO + IF tablist[i]=window_name THEN + tabs.TabIndex:=i; + END; + + +END. Index: /oup/releases/0.20a/Unit2_functions.pas =================================================================== --- /oup/releases/0.20a/Unit2_functions.pas (revision 21) +++ /oup/releases/0.20a/Unit2_functions.pas (revision 21) @@ -0,0 +1,452 @@ +UNIT Unit2_functions; +INTERFACE +USES Classes, Dialogs, SysUtils, StrUtils, Math, SQLiteTable3, + Unit3_data, Unit4_Exporters; + +TYPE + TExportSet=SET OF (DO_dat,DO_raw,DO_convert,DO_toone); + +FUNCTION GetFilesList(ext:String; pattern:String; NoEmptyFiles:Boolean):TStringList; +FUNCTION GetExtensionsList:TStringList; + +FUNCTION Decode_Int(buffer:Tdata):LongWord; +FUNCTION Encode_Int(input:LongWord):Tdata; +FUNCTION Decode_Float(buffer:Tdata):Single; +FUNCTION Encode_Float(input:Single):Tdata; + +FUNCTION LoadDatInfos(filename:String):Boolean; +PROCEDURE OpenDatabase(FileName:String); + +FUNCTION LoadDatFile(fileid:LongWord):Tdata; +PROCEDURE UpdateDatFile(fileid:LongWord; data:Tdata); +FUNCTION LoadDatFilePart(fileid,offset,size:LongWord; target:Pointer):Boolean; +FUNCTION UpdateDatFilePart(fileid,offset,size:LongWord; target:Pointer):Boolean; + +FUNCTION LoadRawFile(fileid,datlinkoffset,size:LongWord; target:Pointer):Boolean; +FUNCTION UpdateRawFile(fileid,datlinkoffset,size:LongWord; target:Pointer):Boolean; + +FUNCTION ExportFile(fileid:LongWord; filename:String; settings:TExportSet; path:String):Integer; + +FUNCTION FormatNumber(value:LongWord; width:Byte; leadingzeros:Char):String; +FUNCTION FormatFileSize(size:LongWord):String; +FUNCTION CreateHexString(data:Tdata; HexOnly:Boolean):String; +FUNCTION GetWinFileName(name:String):String; +FUNCTION GetExtractPath:String; + + +IMPLEMENTATION + +TYPE + TValueSwitcher=Record + CASE IsFloat: Boolean OF + True: (ValueFloat:Single); + False: (ValueInt:LongWord); + END; + +FUNCTION Decode_Int(buffer:Tdata):LongWord; + BEGIN + Result:=buffer[0]+buffer[1]*256+buffer[2]*256*256+buffer[3]*256*256*256; + END; +FUNCTION Encode_Int(input:LongWord):Tdata; + BEGIN + Result[0]:=input MOD 256; + input:=input DIV 256; + Result[1]:=input MOD 256; + input:=input DIV 256; + Result[2]:=input MOD 256; + input:=input DIV 256; + Result[3]:=input MOD 256; + END; +FUNCTION Decode_Float(buffer:Tdata):Single; + VAR _valueswitcher:TValueSwitcher; + BEGIN + _valueswitcher.ValueInt:=Decode_Int(buffer); + Result:=_valueswitcher.ValueFloat; + END; +FUNCTION Encode_Float(input:Single):Tdata; + VAR _valueswitcher:TValueSwitcher; + BEGIN + _valueswitcher.ValueFloat:=input; + Result:=Encode_Int(_valueswitcher.ValueInt); + END; + + +FUNCTION GetFilesList(ext:String; pattern:String; NoEmptyFiles:Boolean):TStringList; + VAR + i:LongWord; + where:String; + Tbl:TSQLiteTable; + BEGIN + SetLength(Result,0); + IF opened_state=opened_dat THEN BEGIN + FOR i:=0 TO dat_header.Files-1 DO BEGIN + IF ( (Length(ext)=0) OR (dat_files[i].Extension=ext) ) AND + ( (Length(pattern)=0) OR (Pos(pattern,dat_files[i].Name)>0) ) THEN BEGIN + IF NoEmptyFiles THEN BEGIN + IF (dat_files[i].FileType AND $02)=0 THEN BEGIN + SetLength(Result,Length(Result)+1); + Result[High(Result)]:=dat_files[i].FileName; + END; + END ELSE BEGIN + SetLength(Result,Length(Result)+1); + Result[High(Result)]:=dat_files[i].FileName; + END; + END; + END; + END ELSE BEGIN + where:=''; + IF Length(ext)>0 THEN BEGIN + IF Length(where)>0 THEN where:=where+' AND '; + where:=where+'(extension="'+ext+'")'; + END; + IF Length(pattern)>0 THEN BEGIN + IF Length(where)>0 THEN where:=where+' AND '; + where:=where+'(name LIKE "%'+pattern+'%")'; + END; + IF NoEmptyFiles THEN BEGIN + IF Length(where)>0 THEN where:=where+' AND '; + where:=where+'((contenttype & 2)=0)'; + END; + IF Length(where)>0 THEN where:=' WHERE '+where; + Tbl:=DB.GetTable('SELECT id,name,extension FROM datfiles'+where+' ORDER BY id ASC;'); + IF Tbl.Count>0 THEN BEGIN + SetLength(Result,Tbl.Count); + i:=0; + REPEAT + Result[i]:=FormatNumber(Tbl.FieldAsInteger('id'),5,'0')+'-'+Tbl.FieldAsString('name')+'.'+Tbl.FieldAsString('extension'); + Inc(i); + Tbl.Next; + UNTIL Tbl.EOF; + END; + END; + END; + +FUNCTION GetExtensionsList:TStringList; + VAR + i:LongWord; + Tbl:TSQLiteTable; + BEGIN + SetLength(Result,0); + IF opened_state=opened_dat THEN BEGIN + FOR i:=0 TO dat_header.Extensions-1 DO BEGIN + SetLength(Result,Length(Result)+1); + WITH dat_extensionsmap[i] DO BEGIN + Result[High(Result)]:=Extension[3]+Extension[2]+Extension[1]+Extension[0]+' ('+IntToStr(ExtCount)+')'; + END; + END; + END ELSE BEGIN + Tbl:=DB.GetTable('SELECT extension,count(extension) AS x FROM datfiles GROUP BY extension ORDER BY extension ASC;'); + IF Tbl.Count>0 THEN BEGIN + SetLength(Result,Tbl.Count); + i:=0; + REPEAT + Result[i]:=Tbl.FieldAsString('extension')+' ('+IntToStr(Tbl.FieldAsInteger('x'))+')'; + Inc(i); + Tbl.Next; + UNTIL Tbl.EOF; + END; + END; + END; + +FUNCTION LoadDatInfos(filename:String):Boolean; + VAR i:LongWord; + dat_file:TFileStream; + BEGIN + Result:=True; + opened_state:=opened_dat; + dat_filename:=filename; + raw_filename:=MidStr(filename,1,Length(filename)-3)+'raw'; + dat_file:=TFileStream.Create(filename, fmOpenRead); + dat_file.Read(dat_header,SizeOf(dat_header)); + FOR i:=0 TO High(dat_header.Ident) DO + IF dat_header.Ident[i]<>header_ident1[i] THEN BEGIN + Result:=False; + Exit; + END; + SetLength(dat_filesmap,dat_header.Files); + SetLength(dat_files,dat_header.Files); + FOR i:=0 TO dat_header.Files-1 DO dat_file.Read(dat_filesmap[i],SizeOf(dat_filesmap[i])); + FOR i:=0 TO dat_header.Files-1 DO BEGIN + dat_files[i].Extension:=dat_filesmap[i].Extension; + dat_files[i].Extension:=ReverseString(dat_files[i].Extension); + dat_files[i].Size:=dat_filesmap[i].FileSize; + dat_files[i].FileType:=dat_filesmap[i].FileType; + dat_files[i].DatAddr:=dat_filesmap[i].DataAddr-8+dat_header.DataAddr; + IF (dat_filesmap[i].FileType AND $01)=0 THEN BEGIN + dat_file.Seek(dat_filesmap[i].NameAddr+dat_header.NamesAddr,soFromBeginning); + SetLength(dat_files[i].Name,100); + dat_file.Read(dat_files[i].Name[1],100); + dat_files[i].Name:=MidStr(dat_files[i].Name,1+4,Pos(#0,dat_files[i].Name)-1-4); + END ELSE BEGIN + dat_files[i].Name:=''; + END; + dat_files[i].FileName:=FormatNumber(i,5,'0')+'-'+dat_files[i].Name+'.'+dat_files[i].Extension; + END; + dat_file.Seek($40+dat_header.Files*$14,soFromBeginning); + SetLength(dat_namedfilesmap,dat_header.NamedFiles); + FOR i:=0 TO dat_header.NamedFiles-1 DO dat_file.Read(dat_namedfilesmap[i],SizeOf(dat_namedfilesmap[i])); + + dat_file.Seek($40+dat_header.Files*$14+dat_header.NamedFiles*$8,soFromBeginning); + SetLength(dat_extensionsmap,dat_header.Extensions); + FOR i:=0 TO dat_header.Extensions-1 DO dat_file.Read(dat_extensionsmap[i],SizeOf(dat_extensionsmap[i])); + + dat_file.Free; + END; + + +FUNCTION LoadDatFile(fileid:LongWord):Tdata; + VAR + dat_file:TFileStream; + Tbl:TSQLiteTable; + mem:TMemoryStream; + BEGIN + IF opened_state=opened_dat THEN BEGIN + dat_file:=TFileStream.Create(dat_filename, fmOpenRead); + dat_file.Seek(dat_files[fileid].DatAddr,soFromBeginning); + SetLength(Result,dat_files[fileid].Size); + dat_file.Read(Result[0],dat_files[fileid].Size); + dat_file.Free; + END ELSE BEGIN + Tbl:=DB.GetTable('SELECT data FROM datfiles WHERE id='+IntToStr(fileid)+';'); + IF Tbl.Count>0 THEN BEGIN + mem:=Tbl.FieldAsBlob('data'); + SetLength(Result,mem.Size); + mem.Seek(0,soFromBeginning); + mem.Read(Result[0],mem.Size); + mem.Free; + END; + END; + END; +PROCEDURE UpdateDatFile(fileid:LongWord; data:Tdata); + VAR + dat_file:TFileStream; + Tbl:TSQLiteTable; + BEGIN + IF opened_state=opened_dat THEN BEGIN + dat_file:=TFileStream.Create(dat_filename, fmOpenReadWrite); + dat_file.Seek(dat_files[fileid].DatAddr,soFromBeginning); + dat_file.Write(data[0],Length(data)); + dat_file.Free; + END ELSE BEGIN + END; + END; + +FUNCTION LoadDatFilePart(fileid,offset,size:LongWord; target:Pointer):Boolean; + VAR + dat_file:TFileStream; + Tbl:TSQLiteTable; + mem:TMemoryStream; + BEGIN + IF opened_state=opened_dat THEN BEGIN + dat_file:=TFileStream.Create(dat_filename, fmOpenRead); + Result:=True; + dat_file.Seek(dat_files[fileid].DatAddr+offset,soFromBeginning); + dat_file.Read(target^,size); + dat_file.Free; + END ELSE BEGIN + Tbl:=DB.GetTable('SELECT data FROM datfiles WHERE id='+IntToStr(fileid)+';'); + IF Tbl.Count>0 THEN BEGIN + Result:=True; + mem:=Tbl.FieldAsBlob('data'); + mem.Seek(offset,soFromBeginning); + mem.Read(target^,size); + mem.Free; + END; + END; + END; +FUNCTION UpdateDatFilePart(fileid,offset,size:LongWord; target:Pointer):Boolean; + VAR + dat_file:TFileStream; + Tbl:TSQLiteTable; + BEGIN + IF opened_state=opened_dat THEN BEGIN + dat_file:=TFileStream.Create(dat_filename, fmOpenReadWrite); + Result:=True; + dat_file.Seek(dat_files[fileid].DatAddr+offset,soFromBeginning); + dat_file.Write(target^,size); + dat_file.Free; + END ELSE BEGIN + END; + END; + +FUNCTION LoadRawFile(fileid,datlinkoffset,size:LongWord; target:Pointer):Boolean; + VAR + filestream:TFileStream; + raw_addr:LongWord; + Tbl:TSQLiteTable; + mem:TMemoryStream; + BEGIN + IF opened_state=opened_dat THEN BEGIN + Result:=True; + LoadDatFilePart(fileid,datlinkoffset,4,@raw_addr); + filestream:=TFileStream.Create(AnsiReplaceStr(dat_filename,'.dat','.raw'),fmOpenRead); + filestream.Seek(raw_addr,soFromBeginning); + filestream.Read(target^,size); + filestream.Free; + END ELSE BEGIN + Tbl:=DB.GetTable('SELECT data FROM rawmap WHERE (src_id='+IntToStr(fileid)+') AND (src_link_offset='+IntToStr(datlinkoffset)+');'); + IF Tbl.Count>0 THEN BEGIN + Result:=True; + mem:=Tbl.FieldAsBlob('data'); + mem.Seek(0,soFromBeginning); + mem.Read(target^,size); + mem.Free; + END; + END; + END; +FUNCTION UpdateRawFile(fileid,datlinkoffset,size:LongWord; target:Pointer):Boolean; + VAR + filestream:TFileStream; + raw_addr:LongWord; + BEGIN + IF opened_state=opened_dat THEN BEGIN + Result:=True; + LoadDatFilePart(fileid,datlinkoffset,4,@raw_addr); + filestream:=TFileStream.Create(AnsiReplaceStr(dat_filename,'.dat','.raw'),fmOpenReadWrite); + filestream.Seek(raw_addr,soFromBeginning); + filestream.Write(target^,size); + filestream.Free; + END ELSE BEGIN + END; + END; + + +FUNCTION FormatNumber(value:LongWord; width:Byte; leadingzeros:Char):String; + BEGIN + Result:=AnsiReplaceStr(Format('%'+IntToStr(width)+'u',[value]),' ',leadingzeros); + END; + +FUNCTION FormatFileSize(size:LongWord):String; + BEGIN + IF size>=1000*1024*1024 THEN BEGIN + Result:=FloatToStrF(size/1024/1024/1024,ffFixed,5,1)+' GB'; + END ELSE BEGIN + IF size>=1000*1024 THEN BEGIN + Result:=FloatToStrF(size/1024/1024,ffFixed,5,1)+' MB'; + END ELSE BEGIN + IF size>=1000 THEN BEGIN + Result:=FloatToStrF(size/1024,ffFixed,5,1)+' KB'; + END ELSE BEGIN + Result:=IntToStr(size)+' B'; + END; + END; + END; + END; + +FUNCTION CreateHexString(data:Tdata; HexOnly:Boolean):String; + VAR + string_build,ascii_version:String; + i:LongWord; + BEGIN + string_build:=''; + ascii_version:=''; + FOR i:=0 TO High(data) DO BEGIN + IF NOT HexOnly THEN + IF (i MOD 16)=0 THEN + string_build:=string_build+'0x'+IntToHex(i,6)+' '; + string_build:=string_build+IntToHex(data[i],2); + IF NOT HexOnly THEN BEGIN + IF data[i]>=32 THEN ascii_version:=ascii_version+Chr(data[i]) + ELSE ascii_version:=ascii_version+'.'; + IF ((i+1) MOD 2)=0 THEN string_build:=string_build+#32; + IF ((i+1) MOD 16)=0 THEN BEGIN + string_build:=string_build+#32+ascii_version+CrLf; + ascii_version:=''; + END; + END; + END; + Result:=string_build; + END; + + +FUNCTION ExportFile(fileid:LongWord; filename:String; settings:TExportSet; path:String):Integer; + VAR + i:Byte; + extension:String; + BEGIN + Result:=export_noerror; + extension:=RightStr(filename,4); + IF DO_dat IN settings THEN ExportDatFile(fileid,path+'\'+GetWinFileName(filename)); + IF DO_raw IN settings THEN BEGIN + FOR i:=1 TO Length(ExportHandlers)+1 DO BEGIN + IF i<=Length(ExportHandlers) THEN BEGIN + IF ExportHandlers[i].Ext=extension THEN BEGIN + IF ExportHandlers[i].needed THEN BEGIN + CASE ExportHandlers[i].Handler(fileid,path+'\'+GetWinFileName(filename),(DO_convert IN settings)) OF + 0: Result:=0; + ELSE + Result:=export_handlererror; + END; + END; + Break; + END; + END ELSE BEGIN + Result:=export_nohandler; + END; + END; + END; + END; + + +FUNCTION GetWinFileName(name:String):String; + BEGIN + Result:=name; + Result:=AnsiReplaceStr(Result,'\','__'); + Result:=AnsiReplaceStr(Result,'/','__'); + Result:=AnsiReplaceStr(Result,'>','__'); + Result:=AnsiReplaceStr(Result,'<','__'); + END; + +FUNCTION GetExtractPath:String; + BEGIN + Result:=ExtractFilePath(dat_filename)+'\extracted_'+ExtractFileName(dat_filename); + END; + + +PROCEDURE OpenDatabase(FileName:String); + VAR + i:Byte; + data:Tdata; + temps:String; + Tbl: TSQLiteTable; + BEGIN + IF NOT FileExists(FileName) THEN BEGIN + ShowMessage('File doesn''t exist!!!'); + Exit; + END; + DB:=TSQLiteDatabase.Create(FileName); + Tbl:=DB.GetTable('SELECT name,value FROM globals ORDER BY name ASC'); + REPEAT + IF Tbl.FieldAsString('name')='dbversion' THEN BEGIN + IF Tbl.FieldAsString('value')<>DBversion THEN BEGIN + ShowMessage('Database-file '+CrLf+'"'+FileName+'"'+CrLf+'has wrong version. (Required: '+DBversion+'; found: '+Tbl.FieldAsString('value')+')'); + Exit; + END; + END; + IF Tbl.FieldAsString('name')='lvl' THEN BEGIN + database_level:=StrToInt(Tbl.FieldAsString('value')); + END; + IF Tbl.FieldAsString('name')='ident' THEN BEGIN + temps:=Tbl.FieldAsString('value'); + FOR i:=0 TO High(database_ident) DO BEGIN + CASE temps[(i*2)+1+0] OF + '0'..'9': database_ident[i]:=Ord(temps[(i*2)+1+0])-48; + 'A'..'F': database_ident[i]:=Ord(temps[(i*2)+1+0])-55; + END; + database_ident[i]:=database_ident[i]*16; + CASE temps[(i*2)+1+1] OF + '0'..'9': database_ident[i]:=database_ident[i]+Ord(temps[(i*2)+1+0])-48; + 'A'..'F': database_ident[i]:=database_ident[i]+Ord(temps[(i*2)+1+0])-55; + END; + END; + END; + Tbl.Next; + UNTIL Tbl.EOF; + Tbl.Free; + opened_state:=opened_db; + END; + + + + +END. Index: /oup/releases/0.20a/Unit3_data.pas =================================================================== --- /oup/releases/0.20a/Unit3_data.pas (revision 21) +++ /oup/releases/0.20a/Unit3_data.pas (revision 21) @@ -0,0 +1,103 @@ +UNIT Unit3_data; +INTERFACE +USES Classes, SQLiteTable3; + +VAR + DB: TSQLiteDatabase; + +CONST + version:String='v0.20a'; + dbversion:String='0.1'; + CrLf:String[2]=#13+#10; + +TYPE + Tdata=Array OF Byte; + Theader=PACKED RECORD + Ident:Array[0..$13] OF Byte; + Files:LongWord; + NamedFiles:LongWord; + Extensions:LongWord; + DataAddr:LongWord; + DataSize:LongWord; + NamesAddr:LongWord; + NamesSize:LongWord; + Ident2:Array[0..$F] OF Byte; + END; + Tfilesmap=Array OF PACKED RECORD + Extension:Array[0..$3] OF Char; + DataAddr:LongWord; + NameAddr:LongWord; + FileSize:LongWord; + FileType:LongWord; + END; + Tfiles=Array OF PACKED RECORD + FileName:String; + Extension:String[4]; + Name:String; + Size:LongWord; + FileType:LongWord; + DatAddr:LongWord; + opened:Boolean; + END; + + Tnamedfilesmap=Array OF PACKED RECORD + FileNumber:LongWord; + blubb:LongWord; + END; + Textensionsmap=Array OF PACKED RECORD + Ident:Array[0..$7] OF Byte; + Extension:Array[0..$3] OF Char; + ExtCount:LongWord; + END; + + TAppSettings=RECORD + DatPath:String[250]; + ExtractPath:String[250]; + END; + + TExportHandlers=RECORD + Ext:String[4]; + needed:Boolean; + Handler:Function(fileid:LongWord; filename:String; convert:Boolean):Integer; + END; + + TStringList=Array OF String; + TExtList=Array OF RECORD + Ext:String; + count:LongWord; + END; + +VAR + opened_state:Byte=0; + dat_filename:String=''; + raw_filename:String=''; + dat_header:Theader; + dat_filesmap:Tfilesmap; + dat_files:Tfiles; + dat_namedfilesmap:Tnamedfilesmap; + dat_extensionsmap:Textensionsmap; + AppSettings:TAppSettings; + AppSettingsFile:File OF TAppSettings; + + database_level:LongWord; + database_ident:Array[0..$13] OF Byte; + +CONST + header_ident1:Array[0..$13] OF Byte= + ($1F,$27,$DC,$33,$DF,$BC,$03,$00,$31,$33,$52,$56,$40,$00,$14,$00,$10,$00,$08,$00); + header_ident2:Array[0..$F] OF Byte= + ($99,$CF,$40,$00,$90,$4F,$63,$00,$F4,$55,$5F,$00,$90,$4F,$63,$00); + + export_noerror:Integer=0; + export_nohandler:Integer=1; + export_handlererror:Integer=2; + export_error:Integer=3; + + opened_nothing:Byte=0; + opened_dat:Byte=1; + opened_db:Byte=2; + +IMPLEMENTATION + +END. + Index: /oup/releases/0.20a/Unit4_Exporters.pas =================================================================== --- /oup/releases/0.20a/Unit4_Exporters.pas (revision 21) +++ /oup/releases/0.20a/Unit4_Exporters.pas (revision 21) @@ -0,0 +1,185 @@ +UNIT Unit4_Exporters; +INTERFACE +USES Classes, Dialogs, StrUtils, SysUtils, Math, Unit3_data, Unit6_imgfuncs; + +PROCEDURE ExportDatFile(fileid:LongWord; filename:String); + +FUNCTION ExportSNDD(fileid:LongWord; filename:String; convert:Boolean):Integer; +FUNCTION ExportTRAC(fileid:LongWord; filename:String; convert:Boolean):Integer; +FUNCTION ExportTXAN(fileid:LongWord; filename:String; convert:Boolean):Integer; +FUNCTION ExportTXMB(fileid:LongWord; filename:String; convert:Boolean):Integer; +FUNCTION ExportTXMP(fileid:LongWord; filename:String; convert:Boolean):Integer; +VAR + ExportHandlers:Array[1..1] OF TExportHandlers=( +// (Ext:'ABNA'; needed:False), + //(Ext:'AGDB'; needed:False), + (Ext:'SNDD'; needed:True; Handler:ExportSNDD) +{ (Ext:'TRAC'; needed:True; Handler:ExportTRAC), + (Ext:'TXAN'; needed:True; Handler:ExportTXAN), + (Ext:'TXMB'; needed:True; Handler:ExportTXMB), + (Ext:'TXMP'; needed:True; Handler:ExportTXMP) +} ); + + + +IMPLEMENTATION +USES Unit2_functions; + +PROCEDURE ExportDatFile(fileid:LongWord; filename:String); + VAR + filestream:TFileStream; + data:Tdata; + BEGIN + data:=LoadDatFile(fileid); + filestream:=TFileStream.Create(filename,fmCreate); + filestream.Write(data[0],Length(data)); + filestream.Free; + END; + +FUNCTION ExportSNDD; + TYPE + TDatData=RECORD + _fileid:LongWord; + level:LongWord; + Flag:LongWord; + ChanNo:LongWord; + SampleRate:LongWord; + BytesPSec:LongWord; + BPSample:LongWord; + BitsPS:LongWord; + Unknown:Array[1..7] OF LongWord; + Unknown2:Word; + RawSize:LongWord; + RawPos:LongWord; + END; + VAR + filestream:TFileStream; + + DatData:TDatData; + //Wave Header Stuff + ASCII_Group:LongWord; //RIFF + WAV_Len:LongWord; + ASCII_WAV:LongWord; //WAVE + ASCII_FMT:LongWord; //"fmt " + WAV_FMT_Len:LongWord; + ASCII_DATA:LongWord; //DATA + WAV_FolLen:LongWord; + + data:Tdata; + BEGIN + Result:=export_noerror; + LoadDatFilePart(fileid,0,SizeOf(DatData),@DatData); + WITH DatData DO BEGIN + //Initializing Header vars + ASCII_Group:=1179011410; + WAV_Len:=RAWSize+70; + ASCII_WAV:=1163280727; + ASCII_FMT:=544501094; + WAV_FMT_Len:=50; + ASCII_DATA:=1635017060; + WAV_FolLen:=RAWSize; + SetLength(data,RAWSize); + LoadRawFile(fileid,68,Length(data),data); + + filestream:=TFileStream.Create(filename+'.raw',fmCreate); + filestream.Write(data[0],Length(data)); + filestream.Free; + + IF convert THEN BEGIN + //Now start packing this into a neat wave... + filestream:=TFileStream.Create(filename+'.wav',fmCreate); + filestream.Write(ASCII_Group,SizeOf(ASCII_Group)); + filestream.Write(WAV_Len,SizeOf(WAV_Len)); + filestream.Write(ASCII_WAV,SizeOf(ASCII_WAV)); + filestream.Write(ASCII_FMT,SizeOf(ASCII_FMT)); + filestream.Write(WAV_FMT_Len,SizeOf(WAV_FMT_Len)); + filestream.Write(ChanNo,SizeOf(ChanNo)); + filestream.Write(Samplerate,SizeOf(Samplerate)); + filestream.Write(BytesPSec,SizeOf(BytesPSec)); + filestream.Write(BPSample,SizeOf(BPSample)); + filestream.Write(BitsPS,SizeOf(BitsPS)); + filestream.Write(Unknown[1],SizeOf(Unknown)); + filestream.Write(Unknown2,SizeOf(Unknown2)); + filestream.Write(ASCII_DATA,SizeOf(ASCII_DATA)); + filestream.Write(WAV_FolLen,SizeOf(WAV_FolLen)); + filestream.Write(data[0],Length(data)); + filestream.Free; + END; + END; + END; + +FUNCTION ExportTRAC; + VAR + link:LongWord; + linkcount:Word; + i:LongWord; + BEGIN + Result:=export_noerror; + + LoadDatFilePart(fileid,$18,SizeOf(link),@link); + link:=link DIV 256; + + LoadDatFilePart(fileid,$1E,SizeOf(linkcount),@linkcount); + FOR i:=1 TO linkcount DO BEGIN + LoadDatFilePart(fileid,$20+(i-1)*12+8,SizeOf(link),@link); + link:=link DIV 256; + END; + END; + +FUNCTION ExportTXAN; + VAR + loop_speed,unknown:Word; + linkcount:LongWord; + link:LongWord; + i:Byte; + BEGIN + Result:=export_noerror; + + LoadDatFilePart(fileid,$14,SizeOf(loop_speed),@loop_speed); + LoadDatFilePart(fileid,$16,SizeOf(unknown),@unknown); + + LoadDatFilePart(fileid,$1C,SizeOf(linkcount),@linkcount); + FOR i:=0 TO linkcount-1 DO BEGIN + LoadDatFilePart(fileid,$20+i*4,SizeOf(link),@link); + link:=link DIV 256; + IF link=0 THEN link:=fileid-1; + END; + END; + +FUNCTION ExportTXMB; + VAR + filestream:TFileStream; + img:TImgPackage; + data:Tdata; + BEGIN + Result:=export_noerror; + IF convert THEN BEGIN + img:=LoadTXMBconnected(fileid); + data:=ImgdataToBmp(img.imgx,img.imgy,img.imgdepth,img.storetype,img.imgdata); + filestream:=TFileStream.Create(filename+'.bmp',fmCreate); + filestream.Write(data[0],Length(data)); + filestream.Free; + END; + END; + +FUNCTION ExportTXMP; + VAR + filestream:TFileStream; + img:TImgPackage; + BEGIN + Result:=export_noerror; + img:=LoadImgData(fileid); + + filestream:=TFileStream.Create(filename+'.raw',fmCreate); + filestream.Write(img.imgdata[0],Length(img.imgdata)); + filestream.Free; + + IF convert THEN BEGIN + img.imgdata:=ImgdataToBMP(img.imgx,img.imgy,img.imgdepth,img.storetype,img.imgdata); + filestream:=TFileStream.Create(filename+'.bmp',fmCreate); + filestream.Write(img.imgdata[0],Length(img.imgdata)); + filestream.Free; + END; + END; + +END. Index: /oup/releases/0.20a/Unit5_preview.dfm =================================================================== --- /oup/releases/0.20a/Unit5_preview.dfm (revision 21) +++ /oup/releases/0.20a/Unit5_preview.dfm (revision 21) @@ -0,0 +1,177 @@ +object Form5: TForm5 + Left = 0 + Top = 0 + Width = 319 + Height = 181 + Caption = 'Preview' + Color = clBtnFace + Font.Charset = DEFAULT_CHARSET + Font.Color = clWindowText + Font.Height = -11 + Font.Name = 'Tahoma' + Font.Style = [] + FormStyle = fsMDIChild + OldCreateOrder = False + Visible = True + WindowState = wsMaximized + OnActivate = FormActivate + OnClose = FormClose + OnCreate = FormCreate + OnResize = FormResize + PixelsPerInch = 96 + TextHeight = 13 + object Splitter1: TSplitter + Left = 150 + Top = 0 + Width = 9 + Height = 154 + AutoSnap = False + Beveled = True + MinSize = 150 + end + object panel_preview: TPanel + Left = 159 + Top = 0 + Width = 152 + Height = 154 + Align = alClient + BevelOuter = bvNone + TabOrder = 0 + object img: TImage + Left = 0 + Top = 20 + Width = 152 + Height = 134 + Align = alClient + end + object lbl_notpossible: TLabel + Left = 16 + Top = 56 + Width = 97 + Height = 65 + AutoSize = False + Caption = 'No preview possible for this filetype' + Font.Charset = DEFAULT_CHARSET + Font.Color = clWindowText + Font.Height = -16 + Font.Name = 'Tahoma' + Font.Style = [] + ParentFont = False + Visible = False + WordWrap = True + end + object panel_buttons: TPanel + Left = 0 + Top = 0 + Width = 152 + Height = 20 + Align = alTop + BevelOuter = bvNone + TabOrder = 0 + Visible = False + OnResize = panel_buttonsResize + object btn_dec: TButton + Left = 0 + Top = 0 + Width = 20 + Height = 20 + Caption = '-' + Enabled = False + TabOrder = 0 + OnClick = btn_decClick + end + object btn_startstop: TButton + Left = 21 + Top = 0 + Width = 80 + Height = 20 + Caption = 'Stop automatic' + TabOrder = 1 + OnClick = btn_startstopClick + end + object btn_inc: TButton + Left = 102 + Top = 0 + Width = 20 + Height = 20 + Caption = '+' + Enabled = False + TabOrder = 2 + OnClick = btn_incClick + end + end + end + object panel_files: TPanel + Left = 0 + Top = 0 + Width = 150 + Height = 154 + Align = alLeft + BevelOuter = bvNone + TabOrder = 1 + object list: TListBox + Left = 0 + Top = 0 + Width = 150 + Height = 129 + Align = alClient + ItemHeight = 13 + PopupMenu = popup + TabOrder = 0 + OnClick = listClick + end + object panel_extension: TPanel + Left = 0 + Top = 129 + Width = 150 + Height = 25 + Align = alBottom + BevelOuter = bvNone + TabOrder = 1 + OnResize = panel_extensionResize + object combo_extension: TComboBox + Left = 2 + Top = 2 + Width = 145 + Height = 21 + Style = csDropDownList + DropDownCount = 12 + Font.Charset = DEFAULT_CHARSET + Font.Color = clWindowText + Font.Height = -11 + Font.Name = 'Tahoma' + Font.Style = [] + ItemHeight = 0 + ParentFont = False + Sorted = True + TabOrder = 0 + OnClick = combo_extensionClick + end + end + end + object timer: TTimer + Enabled = False + OnTimer = timerTimer + Left = 144 + Top = 24 + end + object popup: TPopupMenu + AutoHotkeys = maManual + Left = 48 + Top = 56 + object popup_extractdat: TMenuItem + Caption = 'Extract .dat-file' + Enabled = False + end + object popup_extractdatraw: TMenuItem + Caption = 'Extract .dat-file and corresponding .raw-data' + Enabled = False + end + object popup_extractdatrawconvert: TMenuItem + Caption = + 'Extract .dat-file and corresponding .raw-data and convert if pos' + + 'sible' + Enabled = False + end + end +end Index: /oup/releases/0.20a/Unit5_preview.pas =================================================================== --- /oup/releases/0.20a/Unit5_preview.pas (revision 21) +++ /oup/releases/0.20a/Unit5_preview.pas (revision 21) @@ -0,0 +1,257 @@ +UNIT Unit5_preview; +INTERFACE +USES + Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, + Dialogs, Math, ExtCtrls, Unit2_functions, Unit3_data, Unit4_exporters, Unit6_imgfuncs, + StdCtrls, StrUtils, Menus; + +TYPE + TForm5 = Class(TForm) + timer: TTimer; + panel_preview: TPanel; + img: TImage; + panel_buttons: TPanel; + btn_dec: TButton; + btn_startstop: TButton; + btn_inc: TButton; + panel_files: TPanel; + list: TListBox; + panel_extension: TPanel; + combo_extension: TComboBox; + Splitter1: TSplitter; + lbl_notpossible: TLabel; + popup: TPopupMenu; + popup_extractdat: TMenuItem; + popup_extractdatraw: TMenuItem; + popup_extractdatrawconvert: TMenuItem; + procedure FormActivate(Sender: TObject); + PROCEDURE Recreatelist; + PROCEDURE listClick(Sender: TObject); + PROCEDURE PreviewTXAN; + PROCEDURE PreviewTXMB; + PROCEDURE PreviewTXMP; + PROCEDURE panel_extensionResize(Sender: TObject); + PROCEDURE combo_extensionClick(Sender: TObject); + PROCEDURE btn_incClick(Sender: TObject); + PROCEDURE btn_decClick(Sender: TObject); + PROCEDURE FormResize(Sender: TObject); + PROCEDURE btn_startstopClick(Sender: TObject); + PROCEDURE panel_buttonsResize(Sender: TObject); + PROCEDURE timerTimer(Sender: TObject); + PROCEDURE FormCreate(Sender: TObject); + PROCEDURE FormClose(Sender: TObject; var Action: TCloseAction); + PRIVATE + PUBLIC + END; + +VAR + Form5: TForm5; + +IMPLEMENTATION +{$R *.dfm} +USES Unit1_main; +VAR + memstreams:Array OF TMemoryStream; + actualimg:Byte; + _fileid:LongWord; + + +PROCEDURE TForm5.Recreatelist; + VAR + i:LongWord; + exts:TStringList; + BEGIN + combo_extension.Items.Clear; + combo_extension.Items.Add('_All files_ ('{+IntToStr(dat_header.Files)}+')'); + exts:=GetExtensionsList; + FOR i:=0 TO High(exts) DO + combo_extension.Items.Add(exts[i]); + combo_extension.ItemIndex:=0; + combo_extensionClick(Self); + END; + + +PROCEDURE TForm5.listClick(Sender: TObject); + BEGIN + _fileid:=StrToInt(MidStr(list.Items.Strings[list.ItemIndex],1,5)); + lbl_notpossible.Visible:=False; + Self.img.Visible:=True; + Self.timer.Enabled:=False; + Self.panel_buttons.Visible:=False; + IF RightStr(list.Items.Strings[list.ItemIndex],4)='TXAN' THEN PreviewTXAN + ELSE + IF RightStr(list.Items.Strings[list.ItemIndex],4)='TXMB' THEN PreviewTXMB + ELSE + IF RightStr(list.Items.Strings[list.ItemIndex],4)='TXMP' THEN PreviewTXMP + ELSE BEGIN + Self.lbl_notpossible.Visible:=True; + Self.img.Visible:=False; + END; + END; + + +PROCEDURE TForm5.panel_extensionResize(Sender: TObject); + BEGIN + combo_extension.Width:=panel_extension.Width-5; + END; + + +PROCEDURE TForm5.combo_extensionClick(Sender: TObject); + VAR + Extension:String[4]; + files:TStringList; + i:LongWord; + BEGIN + Extension:=MidStr(combo_extension.Items.Strings[combo_extension.ItemIndex],1,4); + list.Items.Clear; + IF Extension='_All' THEN + files:=GetFilesList('','',True) + ELSE + files:=GetFilesList(extension,'',True); + IF Length(files)>0 THEN + FOR i:=0 TO High(files) DO + list.Items.Add(files[i]); + END; + + +PROCEDURE TForm5.PreviewTXMB; + VAR + data:Tdata; + img:TImgPackage; + BEGIN + SetLength(memstreams,1); + img:=LoadTXMBconnected(_fileid); + data:=ImgdataToBmp(img.imgx,img.imgy,img.imgdepth,img.storetype,img.imgdata); + + memstreams[0].Clear; + memstreams[0].Write(data[0],Length(data)); + memstreams[0].Seek(0,soFromBeginning); + + Self.img.Picture.Bitmap.LoadFromStream(memstreams[0]); + END; + +PROCEDURE TForm5.PreviewTXMP; + VAR + data:Tdata; + img:TImgPackage; + BEGIN + SetLength(memstreams,1); + img:=LoadImgData(_fileid); + data:=ImgdataToBmp(img.imgx,img.imgy,img.imgdepth,img.storetype,img.imgdata); + + memstreams[0].Clear; + memstreams[0].Write(data[0],Length(data)); + memstreams[0].Seek(0,soFromBeginning); + + Self.img.Picture.Bitmap.LoadFromStream(memstreams[0]); + END; + +PROCEDURE TForm5.PreviewTXAN; + VAR + loop_speed:Word; + linkcount:LongWord; + link:LongWord; + i:Byte; + data:Tdata; + img:TImgPackage; + BEGIN + LoadDatFilePart(_fileid,$14,SizeOf(loop_speed),@loop_speed); + LoadDatFilePart(_fileid,$1C,SizeOf(linkcount),@linkcount); + SetLength(memstreams,linkcount); + FOR i:=0 TO linkcount-1 DO BEGIN + LoadDatFilePart(_fileid,$20+i*4,SizeOf(link),@link); + link:=link DIV 256; + IF link=0 THEN link:=_fileid-1; + memstreams[i]:=TMemoryStream.Create; + img:=LoadImgData(link); + data:=ImgdataToBmp(img.imgx,img.imgy,img.imgdepth,img.storetype,img.imgdata); + memstreams[i].Clear; + memstreams[i].Write(data[0],Length(data)); + memstreams[i].Seek(0,soFromBeginning); + END; + actualimg:=254; + Self.timer.Interval:=Floor(loop_speed*(1/60)*1000); + Self.timer.Enabled:=False; + Self.btn_startstopClick(Self); + Self.panel_buttons.Visible:=True; + END; + + +PROCEDURE TForm5.FormCreate(Sender: TObject); + BEGIN + SetLength(memstreams,1); + memstreams[0]:=TMemoryStream.Create; + Self.Width:=260; + Self.Height:=300; + END; + +PROCEDURE TForm5.timerTimer(Sender: TObject); + BEGIN + Inc(actualimg); + IF actualimg>=Length(memstreams) THEN actualimg:=0; + Self.img.Picture.Bitmap.LoadFromStream(memstreams[actualimg]); + memstreams[actualimg].Seek(0,soFromBeginning); + Self.Caption:='Preview '+dat_files[_fileid].FileName+' ('+IntToStr(actualimg+1)+'/'+IntToStr(Length(memstreams))+')'; + END; + +PROCEDURE TForm5.panel_buttonsResize(Sender: TObject); + BEGIN + btn_startstop.Width:=panel_buttons.Width-45; + btn_inc.Left:=panel_buttons.Width-23; + END; + +PROCEDURE TForm5.btn_startstopClick(Sender: TObject); + BEGIN + Self.timer.Enabled:=NOT Self.timer.Enabled; + Self.btn_dec.Enabled:=NOT Self.timer.Enabled; + Self.btn_inc.Enabled:=NOT Self.timer.Enabled; + IF Self.timer.Enabled THEN + Self.btn_startstop.Caption:='Stop automatic' + ELSE + Self.btn_startstop.Caption:='Start automatic'; + END; + +PROCEDURE TForm5.FormResize(Sender: TObject); + BEGIN + IF Self.Width>=300 THEN BEGIN + END ELSE Self.Width:=300; + IF Self.Height>=200 THEN BEGIN + END ELSE Self.Height:=200; + END; + +PROCEDURE TForm5.btn_decClick(Sender: TObject); + BEGIN + IF actualimg>0 THEN + Dec(actualimg) + ELSE + actualimg:=High(memstreams); + Self.Caption:='Preview '+dat_files[_fileid].FileName+' ('+IntToStr(actualimg+1)+'/'+IntToStr(Length(memstreams))+')'; + Self.img.Picture.Bitmap.LoadFromStream(memstreams[actualimg]); + memstreams[actualimg].Seek(0,soFromBeginning); + END; + +PROCEDURE TForm5.btn_incClick(Sender: TObject); + BEGIN + IF actualimg0) THEN BEGIN + Inc(row_orig); + IF (row_orig MOD 2)=0 THEN BEGIN + Inc(row); + col:=0; + END; + END; + IF (row_orig MOD 2)=0 THEN BEGIN + IF (i MOD 2)=0 THEN BEGIN + FOR j:=0 TO (imgdepth DIV 8)-1 DO + temparray[((row*(oldx DIV 2))+col)*(imgdepth DIV 8)+j]:=data[i*2+j]; + Inc(col); + END; + END; + END; + Result:=temparray; + END; + + +FUNCTION RevertImage(imgx,imgy,imgdepth:LongWord; imgdata:Tdata):Tdata; + VAR + x,y,i:LongWord; + BEGIN + SetLength(Result,imgx*imgy*(imgdepth DIV 8)); + FOR y:=0 TO imgy-1 DO + FOR x:=0 TO imgx-1 DO + FOR i:=0 TO (imgdepth DIV 8)-1 DO + Result[((imgx*(imgy-1-y)+x)*(imgdepth DIV 8))+i]:= + imgdata[(imgx*y+x)*(imgdepth DIV 8)+i]; + END; + + +FUNCTION DecompressImage(imgx,imgy:LongWord; imgdata:Tdata):Tdata; + TYPE + Tcolor=RECORD + RGBb:Byte; + RGBg:Byte; + RGBr:Byte; + RGBa:Byte; + END; + VAR + i,j,x,y:LongWord; + color:Array[1..4] OF Tcolor; + pixel:Array[1..16] OF Byte; + BEGIN + x:=0; + y:=0; + SetLength(Result,imgx*imgy*4); + FOR i:=0 TO ((imgx*imgy) DIV 16)-1 DO BEGIN + Color[1].RGBb:=Floor(((imgdata[(i*8)+0]+imgdata[(i*8)+1]*256) AND $001F) / $001F * 255); + Color[1].RGBg:=Floor(((imgdata[(i*8)+0]+imgdata[(i*8)+1]*256) AND $07E0) / $07E0 * 255); + Color[1].RGBr:=Floor(((imgdata[(i*8)+0]+imgdata[(i*8)+1]*256) AND $F800) / $F800 * 255); + Color[1].RGBa:=255; + Color[2].RGBb:=Floor(((imgdata[(i*8)+2]+imgdata[(i*8)+3]*256) AND $001F) / $001F * 255); + Color[2].RGBg:=Floor(((imgdata[(i*8)+2]+imgdata[(i*8)+3]*256) AND $07E0) / $07E0 * 255); + Color[2].RGBr:=Floor(((imgdata[(i*8)+2]+imgdata[(i*8)+3]*256) AND $F800) / $F800 * 255); + Color[2].RGBa:=255; + Color[3].RGBb:=Floor( Color[1].RGBb/3*2 + Color[2].RGBb/3 ); + Color[3].RGBg:=Floor( Color[1].RGBg/3*2 + Color[2].RGBg/3 ); + Color[3].RGBr:=Floor( Color[1].RGBr/3*2 + Color[2].RGBr/3 ); + Color[3].RGBa:=255; + Color[4].RGBb:=Floor( Color[1].RGBb/3 + Color[2].RGBb/3*2 ); + Color[4].RGBg:=Floor( Color[1].RGBg/3 + Color[2].RGBg/3*2 ); + Color[4].RGBr:=Floor( Color[1].RGBr/3 + Color[2].RGBr/3*2 ); + Color[4].RGBa:=255; + Pixel[1]:=Floor( (imgdata[(i*8)+4] AND $C0) / $40 + 1 ); + Pixel[2]:=Floor( (imgdata[(i*8)+4] AND $30) / $10 + 1 ); + Pixel[3]:=Floor( (imgdata[(i*8)+4] AND $0C) / $04 + 1 ); + Pixel[4]:=Floor( (imgdata[(i*8)+4] AND $03) + 1 ); + Pixel[5]:=Floor( (imgdata[(i*8)+5] AND $C0) / $40 + 1 ); + Pixel[6]:=Floor( (imgdata[(i*8)+5] AND $30) / $10 + 1 ); + Pixel[7]:=Floor( (imgdata[(i*8)+5] AND $0C) / $04 + 1 ); + Pixel[8]:=Floor( (imgdata[(i*8)+5] AND $03) + 1 ); + Pixel[9]:=Floor( (imgdata[(i*8)+6] AND $C0) / $40 + 1 ); + Pixel[10]:=Floor( (imgdata[(i*8)+6] AND $30) / $10 + 1 ); + Pixel[11]:=Floor( (imgdata[(i*8)+6] AND $0C) / $04 + 1 ); + Pixel[12]:=Floor( (imgdata[(i*8)+6] AND $03) + 1 ); + Pixel[13]:=Floor( (imgdata[(i*8)+7] AND $C0) / $40 + 1 ); + Pixel[14]:=Floor( (imgdata[(i*8)+7] AND $30) / $10 + 1 ); + Pixel[15]:=Floor( (imgdata[(i*8)+7] AND $0C) / $04 + 1 ); + Pixel[16]:=Floor( (imgdata[(i*8)+7] AND $03) + 1 ); + FOR j:=0 TO 3 DO BEGIN + Result[((y+3)*imgx+x+j)*3+0]:=Color[Pixel[16-j]].RGBb; + Result[((y+3)*imgx+x+j)*3+1]:=Color[Pixel[16-j]].RGBg; + Result[((y+3)*imgx+x+j)*3+2]:=Color[Pixel[16-j]].RGBr; + END; + FOR j:=0 TO 3 DO BEGIN + Result[((y+2)*imgx+x+j)*3+0]:=Color[Pixel[12-j]].RGBb; + Result[((y+2)*imgx+x+j)*3+1]:=Color[Pixel[12-j]].RGBg; + Result[((y+2)*imgx+x+j)*3+2]:=Color[Pixel[12-j]].RGBr; + END; + FOR j:=0 TO 3 DO BEGIN + Result[((y+1)*imgx+x+j)*3+0]:=Color[Pixel[8-j]].RGBb; + Result[((y+1)*imgx+x+j)*3+1]:=Color[Pixel[8-j]].RGBg; + Result[((y+1)*imgx+x+j)*3+2]:=Color[Pixel[8-j]].RGBr; + END; + FOR j:=0 TO 3 DO BEGIN + Result[((y+0)*imgx+x+j)*3+0]:=Color[Pixel[4-j]].RGBb; + Result[((y+0)*imgx+x+j)*3+1]:=Color[Pixel[4-j]].RGBg; + Result[((y+0)*imgx+x+j)*3+2]:=Color[Pixel[4-j]].RGBr; + END; + x:=x+4; + IF x=imgx THEN BEGIN + y:=y+4; + x:=0; + END; + END; + END; + + +FUNCTION ImgdataToBmp(imgx,imgy,imgdepth,storetype:LongWord; imgdata:Tdata):Tdata; + CONST BMPheader:Array[0..53] OF Byte= + ($42,$4D,0,0,0,0,0,0,0,0,54,0,0,0, + 40,0,0,0,0,0,0,0,0,0,0,0,1,0,$18,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0); + VAR + i,x,y:LongWord; + BEGIN + CASE storetype OF + 0: BEGIN + SetLength(Result,imgx*imgy*3); + FOR y:=0 TO imgy-1 DO BEGIN + FOR x:=0 TO imgx-1 DO BEGIN + Result[((imgx*y+x)*3)+0]:=Floor( ( (imgdata[(imgx*y+x)*2]+imgdata[(imgx*y+x)*2+1]*256) AND $000F ) / $000F * 255); + Result[((imgx*y+x)*3)+1]:=Floor( ( (imgdata[(imgx*y+x)*2]+imgdata[(imgx*y+x)*2+1]*256) AND $00F0 ) / $00F0 * 255); + Result[((imgx*y+x)*3)+2]:=Floor( ( (imgdata[(imgx*y+x)*2]+imgdata[(imgx*y+x)*2+1]*256) AND $0F00 ) / $0F00 * 255); + END; + END; + END; + 1,2: BEGIN + SetLength(Result,imgx*imgy*3); + FOR y:=0 TO imgy-1 DO BEGIN + FOR x:=0 TO imgx-1 DO BEGIN + Result[((imgx*y+x)*3)+0]:=Floor( ( (imgdata[(imgx*y+x)*2]+imgdata[(imgx*y+x)*2+1]*256) AND $001F ) / $001F * 255); + Result[((imgx*y+x)*3)+1]:=Floor( ( (imgdata[(imgx*y+x)*2]+imgdata[(imgx*y+x)*2+1]*256) AND $03E0 ) / $03E0 * 255); + Result[((imgx*y+x)*3)+2]:=Floor( ( (imgdata[(imgx*y+x)*2]+imgdata[(imgx*y+x)*2+1]*256) AND $7C00 ) / $7C00 * 255); + END; + END; + END; + 8: BEGIN + SetLength(Result,imgx*imgy*3); + FOR y:=0 TO imgy-1 DO BEGIN + FOR x:=0 TO imgx-1 DO BEGIN + Result[((imgx*y+x)*3)+0]:=imgdata[(imgx*y+x)*4+0]; + Result[((imgx*y+x)*3)+1]:=imgdata[(imgx*y+x)*4+1]; + Result[((imgx*y+x)*3)+2]:=imgdata[(imgx*y+x)*4+2]; + END; + END; + END; + 9: BEGIN + Result:=DecompressImage(imgx,imgy,imgdata); + END; + END; + Result:=RevertImage(imgx,imgy,24,Result); + SetLength(Result,imgx*imgy*3+54); + FOR i:=High(Result)-54 DOWNTO 0 DO Result[i+54]:=Result[i]; + + FOR i:=0 TO High(BMPheader) DO Result[i]:=BMPheader[i]; + Result[2]:=((imgx*imgy*3+54) AND $000000FF); + Result[3]:=((imgx*imgy*3+54) AND $0000FF00) DIV $100; + Result[4]:=((imgx*imgy*3+54) AND $00FF0000) DIV $10000; + Result[5]:=((imgx*imgy*3+54) AND $FF000000) DIV $1000000; + Result[18]:=(imgx AND $000000FF) DIV $1; + Result[19]:=(imgx AND $0000FF00) DIV $100; + Result[20]:=(imgx AND $00FF0000) DIV $10000; + Result[21]:=(imgx AND $FF000000) DIV $1000000; + Result[22]:=(imgy AND $000000FF) DIV $1; + Result[23]:=(imgy AND $0000FF00) DIV $100; + Result[24]:=(imgy AND $00FF0000) DIV $10000; + Result[25]:=(imgy AND $FF000000) DIV $1000000; + Result[34]:=((imgx*imgy*3) AND $000000FF) DIV $1; + Result[35]:=((imgx*imgy*3) AND $0000FF00) DIV $100; + Result[36]:=((imgx*imgy*3) AND $00FF0000) DIV $10000; + Result[37]:=((imgx*imgy*3) AND $FF000000) DIV $1000000; + END; + +FUNCTION BmpToImgdata(bmpdata:Tdata; _32bit:Boolean):TImgPackage; + VAR + x,y:LongWord; + r24,g24,b24:Word; + r16,g16,b16:Word; + gesamt:Word; + BEGIN + Result.imgdepth:=0; + IF NOT((bmpdata[00]=$42) AND (bmpdata[01]=$4D)) THEN BEGIN + ShowMessage('Not a standard 24bit bitmap'); + Exit; + END; + IF NOT(bmpdata[10]=54) THEN BEGIN + ShowMessage('Imagedata has to start at 0x54'); + Exit; + END; + IF NOT(bmpdata[14]=40) THEN BEGIN + ShowMessage('Second bitmap header has to have 40 bytes'); + Exit; + END; + IF NOT(bmpdata[28]=24) THEN BEGIN + ShowMessage('Bitmap has to have 24bits'); + Exit; + END; + IF NOT(bmpdata[30]=0) THEN BEGIN + ShowMessage('Bitmap has to be uncompressed'); + Exit; + END; + Result.imgx:=bmpdata[18]+bmpdata[19]*256+bmpdata[20]*256*256+bmpdata[21]*256*256*256; + Result.imgy:=bmpdata[22]+bmpdata[23]*256+bmpdata[24]*256*256+bmpdata[25]*256*256*256; + IF _32bit THEN BEGIN + Result.imgdepth:=32; + Result.storetype:=8; + END ELSE BEGIN + Result.imgdepth:=16; + Result.storetype:=1; + END; + + SetLength(Result.imgdata,Result.imgx*Result.imgy*Result.imgdepth DIV 8); + IF _32bit THEN BEGIN + FOR y:=0 TO Result.imgy-1 DO BEGIN + FOR x:=0 TO Result.imgx-1 DO BEGIN + Result.imgdata[((Result.imgx*y+x)*4)+0]:=bmpdata[54+(Result.imgx*y+x)*3+0]; + Result.imgdata[((Result.imgx*y+x)*4)+1]:=bmpdata[54+(Result.imgx*y+x)*3+1]; + Result.imgdata[((Result.imgx*y+x)*4)+2]:=bmpdata[54+(Result.imgx*y+x)*3+2]; + Result.imgdata[((Result.imgx*y+x)*4)+3]:=0; + END; + END; + END ELSE BEGIN + FOR y:=0 TO Result.imgy-1 DO BEGIN + FOR x:=0 TO Result.imgx-1 DO BEGIN + r24:=bmpdata[54+(Result.imgx*y+x)*3+0]; + g24:=bmpdata[54+(Result.imgx*y+x)*3+1]; + b24:=bmpdata[54+(Result.imgx*y+x)*3+2]; + r16:=(Ceil(r24*$001F/255)) AND $001F; + g16:=(Ceil(g24*$03E0/255)) AND $03E0; + b16:=(Ceil(b24*$7C00/255)) AND $7C00; + gesamt:=r16+g16+b16; + Result.imgdata[((Result.imgx*y+x)*2)+0]:=gesamt AND $00FF; + Result.imgdata[((Result.imgx*y+x)*2)+1]:=(gesamt AND $FF00) DIV 256; + END; + END; + END; + + Result.imgdata:=RevertImage(Result.imgx,Result.imgy,Result.imgdepth,Result.imgdata); + END; + +FUNCTION LoadTXMBconnected(fileid:LongWord):TImgPackage; + VAR + i,x,y,x2,y2,pixelid,imgid:LongWord; + rows,cols:Word; + linkcount:LongWord; + link:LongWord; + single_image:TImgPackage; + images_decoded:Array OF TImgPackage; + x_start,y_start:LongWord; + BEGIN + LoadDatFilePart(fileid,$10,SizeOf(Result.imgx),@Result.imgx); + LoadDatFilePart(fileid,$12,SizeOf(Result.imgy),@Result.imgy); + LoadDatFilePart(fileid,$18,SizeOf(cols),@cols); + LoadDatFilePart(fileid,$1A,SizeOf(rows),@rows); + LoadDatFilePart(fileid,$1C,SizeOf(linkcount),@linkcount); + SetLength(images_decoded,linkcount); + FOR i:=0 TO linkcount-1 DO BEGIN + LoadDatFilePart(fileid,$20+i*4,SizeOf(link),@link); + link:=link DIV 256; + single_image:=LoadImgData(link); + images_decoded[i]:=BmpToImgdata(ImgdataToBmp(single_image.imgx,single_image.imgy,single_image.imgdepth,single_image.storetype,single_image.imgdata),False); + END; + SetLength(Result.imgdata,Result.imgx*Result.imgy*2); + FOR y:=0 TO rows-1 DO BEGIN + FOR x:=0 TO cols-1 DO BEGIN + imgid:=y*cols+x; + x_start:=0; + y_start:=0; + FOR i:=0 TO x DO IF i0 THEN + FOR i:=0 TO High(files) DO + list_txmp.Items.Add(files[i]); + group_bmpselect.Enabled:=False; + check_transparency.Checked:=False; + check_fading.Checked:=False; + END; + + +PROCEDURE TForm7.FormResize(Sender: TObject); + BEGIN + IF Self.Width>=400 THEN BEGIN + END ELSE Self.Width:=400; + IF Self.Height>=350 THEN BEGIN + END ELSE Self.Height:=350; + END; + +PROCEDURE TForm7.list_txmpClick(Sender: TObject); + VAR + id:LongWord; + data:Tdata; + img:TImgPackage; + mem:TMemoryStream; + fadingbyte,depthbyte,storebyte:Byte; + BEGIN + id:=StrToInt(MidStr(list_txmp.Items.Strings[list_txmp.ItemIndex],1,5)); + + LoadDatFilePart(id,$88,SizeOf(fadingbyte),@fadingbyte); + LoadDatFilePart(id,$89,SizeOf(depthbyte),@depthbyte); + LoadDatFilePart(id,$90,SizeOf(storebyte),@storebyte); + check_fading.Checked:=(fadingbyte AND $01)>0; + check_transparency.Checked:=(depthbyte AND $04)>0; + check_32bit.Checked:=(storebyte=8); + + img:=LoadImgData(id); + data:=ImgdataToBmp(img.imgx,img.imgy,img.imgdepth,img.storetype,img.imgdata); + + mem:=TMemoryStream.Create; + mem.Write(data[0],Length(data)); + mem.Seek(0,soFromBeginning); + image_txmppreview.Picture.Bitmap.LoadFromStream(mem); + mem.Free; + + group_bmpselect.Enabled:=True; + END; + +PROCEDURE TForm7.btn_loadClick(Sender: TObject); + VAR + bmpfile:TFileStream; + mem:TMemoryStream; + BEGIN + IF opend.Execute THEN BEGIN + bmpfile:=TFileStream.Create(opend.FileName, fmOpenRead); + SetLength(actual_bmpdata,bmpfile.Size); + bmpfile.Read(actual_bmpdata[0],bmpfile.Size); + bmpfile.Free; + + mem:=TMemoryStream.Create; + mem.Write(actual_bmpdata[0],Length(actual_bmpdata)); + mem.Seek(0,soFromBeginning); + image_bmppreview.Picture.Bitmap.LoadFromStream(mem); + mem.Free; + + group_options.Enabled:=True; + END; + END; + +PROCEDURE TForm7.btn_replaceClick(Sender: TObject); + VAR + id:LongWord; + imgpkg:TImgPackage; + rawfile:TFileStream; + dataddr:LongWord; + old_rawaddr,new_rawaddr:LongWord; + oldwidth,oldheight:Word; + oldstore,olddepth,oldfading:Byte; + oldsize:LongWord; + newsize:LongWord; + datbyte:Word; + BEGIN + IF list_txmp.ItemIndex>=0 THEN BEGIN + imgpkg:=BmpToImgdata(actual_bmpdata,check_32bit.Checked); + + id:=StrToInt(MidStr(list_txmp.Items.Strings[list_txmp.ItemIndex],1,5)); + LoadDatFilePart(id,$8C,2,@oldwidth); + LoadDatFilePart(id,$8E,2,@oldheight); + LoadDatFilePart(id,$88,1,@oldfading); + LoadDatFilePart(id,$89,1,@olddepth); + LoadDatFilePart(id,$90,1,@oldstore); + LoadDatFilePart(id,$9C,4,@old_rawaddr); + IF (oldwidth<>imgpkg.imgx) OR (oldheight<>imgpkg.imgy) THEN BEGIN + IF MessageBox(Self.Handle, + PChar('Current image and new image have different size'+CrLf+ + '(Current: '+IntToStr(oldwidth)+'x'+IntToStr(oldheight)+ + ' - New: '+IntToStr(imgpkg.imgx)+'x'+IntToStr(imgpkg.imgy)+')'+CrLf+ + 'Replace anyways?'), + PChar(list_txmp.Items.Strings[list_txmp.ItemIndex]), + MB_YESNO)=IDNO THEN Exit; + END; + + rawfile:=TFileStream.Create(raw_filename,fmOpenReadWrite); + + CASE oldstore OF + 9: oldsize:=GetImageDataSize(oldwidth,oldheight,8,(oldfading AND $01)>0); + 0,1,2: oldsize:=GetImageDataSize(oldwidth,oldheight,16,(oldfading AND $01)>0); + 8: oldsize:=GetImageDataSize(oldwidth,oldheight,32,(oldfading AND $01)>0); + ELSE + oldsize:=0; + END; + IF check_32bit.Checked THEN + newsize:=GetImageDataSize(imgpkg.imgx,imgpkg.imgy,32,check_fading.Checked) + ELSE + newsize:=GetImageDataSize(imgpkg.imgx,imgpkg.imgy,16,check_fading.Checked); + + IF newsize<=oldsize THEN + new_rawaddr:=old_rawaddr + ELSE + new_rawaddr:=rawfile.Size; + + datbyte:=$00; + IF check_fading.Checked THEN datbyte:=datbyte OR $01; + UpdateDatFilePart(id,$88,1,@datbyte); + datbyte:=$10; + IF check_transparency.Checked THEN datbyte:=datbyte OR $04; + UpdateDatFilePart(id,$89,1,@datbyte); + UpdateDatFilePart(id,$8C,2,@imgpkg.imgx); + UpdateDatFilePart(id,$8E,2,@imgpkg.imgy); + IF check_32bit.Checked THEN + datbyte:=$08 + ELSE + datbyte:=$01; + UpdateDatFilePart(id,$90,1,@datbyte); + UpdateDatFilePart(id,$9C,4,@new_rawaddr); + + IF check_fading.Checked THEN BEGIN + imgpkg.imgdata:=CreateFadedImage(imgpkg); + END; + + rawfile.Seek(new_rawaddr,soFromBeginning); + rawfile.Write(imgpkg.imgdata[0],Length(imgpkg.imgdata)); + rawfile.Free; + + ShowMessage('TXMP-image replaced'); + END; + END; + +PROCEDURE TForm7.FormClose(Sender: TObject; var Action: TCloseAction); + BEGIN + Action:=caFree; + Form1.close_window(Self.Name); + END; + +PROCEDURE TForm7.FormActivate(Sender: TObject); + BEGIN + Form1.SetActiveWindow(Self.Name); + END; + +PROCEDURE TForm7.btn_saveClick(Sender: TObject); + VAR + filestream:TFileStream; + img:TImgPackage; + BEGIN + IF saved.Execute THEN BEGIN + img:=LoadImgData(StrToInt(MidStr(list_txmp.Items.Strings[list_txmp.ItemIndex],1,5))); + img.imgdata:=ImgdataToBMP(img.imgx,img.imgy,img.imgdepth,img.storetype,img.imgdata); + filestream:=TFileStream.Create(saved.FileName,fmCreate); + filestream.Write(img.imgdata[0],Length(img.imgdata)); + filestream.Free; + END; + END; + +END. Index: /oup/releases/0.20a/Unit8_binedit.dfm =================================================================== --- /oup/releases/0.20a/Unit8_binedit.dfm (revision 21) +++ /oup/releases/0.20a/Unit8_binedit.dfm (revision 21) @@ -0,0 +1,207 @@ +object Form8: TForm8 + Left = 0 + Top = 0 + Width = 650 + Height = 450 + Caption = 'Binary .dat-Editor' + Color = clBtnFace + Font.Charset = DEFAULT_CHARSET + Font.Color = clWindowText + Font.Height = -11 + Font.Name = 'Tahoma' + Font.Style = [] + FormStyle = fsMDIChild + OldCreateOrder = False + Visible = True + WindowState = wsMaximized + OnActivate = FormActivate + OnClose = FormClose + OnCloseQuery = FormCloseQuery + OnCreate = FormCreate + OnResize = FormResize + PixelsPerInch = 96 + TextHeight = 13 + object Splitter1: TSplitter + Left = 150 + Top = 0 + Width = 9 + Height = 423 + AutoSnap = False + Beveled = True + MinSize = 150 + end + object panel_data: TPanel + Left = 159 + Top = 0 + Width = 483 + Height = 423 + Align = alClient + BevelOuter = bvNone + TabOrder = 0 + OnResize = panel_dataResize + object Splitter2: TSplitter + Left = 0 + Top = 300 + Width = 483 + Height = 9 + Cursor = crVSplit + Align = alTop + AutoSnap = False + Beveled = True + MinSize = 50 + end + object hex: TMPHexEditor + Left = 0 + Top = 0 + Width = 483 + Height = 300 + Cursor = crIBeam + Align = alTop + Font.Charset = DEFAULT_CHARSET + Font.Color = clWindowText + Font.Height = -16 + Font.Name = 'Courier' + Font.Style = [] + ParentFont = False + TabOrder = 0 + BytesPerRow = 16 + Translation = tkASCII + OffsetFormat = '6!10:0x|' + Colors.Background = clWindow + Colors.ChangedBackground = clWindow + Colors.ChangedText = clRed + Colors.CursorFrame = clNavy + Colors.Offset = clBlack + Colors.OddColumn = clBlue + Colors.EvenColumn = clNavy + Colors.CurrentOffsetBackground = clBtnShadow + Colors.OffsetBackGround = clBtnFace + Colors.CurrentOffset = clBtnHighlight + Colors.Grid = clBtnFace + Colors.NonFocusCursorFrame = clAqua + Colors.ActiveFieldBackground = clWindow + FocusFrame = True + AllowInsertMode = False + DrawGridLines = False + Version = 'May 23, 2005; '#169' markus stephany, vcl[at]mirkes[dot]de' + OnChange = hexChange + ShowPositionIfNotFocused = True + OnSelectionChanged = hexSelectionChanged + end + object structs: TWrapGrid + Left = 0 + Top = 309 + Width = 483 + Height = 114 + Align = alClient + DefaultColWidth = 92 + DefaultRowHeight = 18 + FixedCols = 0 + Options = [goFixedVertLine, goFixedHorzLine, goVertLine, goHorzLine, goColSizing] + TabOrder = 1 + OnClick = structsClick + end + end + object panel_files: TPanel + Left = 0 + Top = 0 + Width = 150 + Height = 423 + Align = alLeft + BevelOuter = bvNone + TabOrder = 1 + object Bevel1: TBevel + Left = 0 + Top = 359 + Width = 150 + Height = 6 + Align = alBottom + Style = bsRaised + end + object list: TListBox + Left = 0 + Top = 0 + Width = 150 + Height = 315 + Align = alClient + ItemHeight = 13 + TabOrder = 0 + OnClick = listClick + end + object panel_extension: TPanel + Left = 0 + Top = 315 + Width = 150 + Height = 44 + Align = alBottom + BevelOuter = bvNone + TabOrder = 1 + OnResize = panel_extensionResize + object lbl_filter: TLabel + Left = 2 + Top = 4 + Width = 100 + Height = 17 + AutoSize = False + Caption = '&Filter by extension:' + FocusControl = combo_extension + end + object combo_extension: TComboBox + Left = 2 + Top = 20 + Width = 145 + Height = 21 + Style = csDropDownList + DropDownCount = 12 + Font.Charset = DEFAULT_CHARSET + Font.Color = clWindowText + Font.Height = -11 + Font.Name = 'Tahoma' + Font.Style = [] + ItemHeight = 13 + ParentFont = False + Sorted = True + TabOrder = 0 + OnClick = combo_extensionClick + end + end + object panel_imexport: TPanel + Left = 0 + Top = 365 + Width = 150 + Height = 58 + Align = alBottom + BevelOuter = bvNone + TabOrder = 2 + OnResize = panel_imexportResize + object btn_export: TButton + Left = 4 + Top = 4 + Width = 142 + Height = 25 + Caption = '&Export to file...' + TabOrder = 0 + OnClick = btn_exportClick + end + object btn_import: TButton + Left = 4 + Top = 32 + Width = 142 + Height = 25 + Caption = '&Import from file...' + TabOrder = 1 + OnClick = btn_importClick + end + end + end + object opend: TOpenDialog + Options = [ofPathMustExist, ofFileMustExist, ofEnableSizing] + Left = 120 + Top = 392 + end + object saved: TSaveDialog + Options = [ofOverwritePrompt, ofPathMustExist, ofEnableSizing] + Left = 120 + Top = 368 + end +end Index: /oup/releases/0.20a/Unit8_binedit.pas =================================================================== --- /oup/releases/0.20a/Unit8_binedit.pas (revision 21) +++ /oup/releases/0.20a/Unit8_binedit.pas (revision 21) @@ -0,0 +1,407 @@ +UNIT Unit8_binedit; +INTERFACE +USES + Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, + Dialogs, Wrapgrid, StdCtrls, Grids, StrUtils, MPHexEditor, ExtCtrls, + Unit3_data, Unit2_functions, Unit9_data_structures, Unit4_exporters; + +TYPE + TForm8 = Class(TForm) + Splitter1: TSplitter; + panel_data: TPanel; + hex: TMPHexEditor; + Splitter2: TSplitter; + structs: TWrapGrid; + panel_files: TPanel; + list: TListBox; + panel_extension: TPanel; + lbl_filter: TLabel; + combo_extension: TComboBox; + Bevel1: TBevel; + panel_imexport: TPanel; + btn_export: TButton; + btn_import: TButton; + opend: TOpenDialog; + saved: TSaveDialog; +{ PROCEDURE structsGetEditText(Sender: TObject; ACol, ARow: Integer; var Value: string); + PROCEDURE structsSetEditText(Sender: TObject; ACol, ARow: Integer; const Value: string); + PROCEDURE structsKeyPress(Sender: TObject; var Key: Char); +} PROCEDURE FormActivate(Sender: TObject); + PROCEDURE btn_importClick(Sender: TObject); + PROCEDURE btn_exportClick(Sender: TObject); + PROCEDURE panel_imexportResize(Sender: TObject); + FUNCTION Save:Boolean; + PROCEDURE FormClose(Sender: TObject; var Action: TCloseAction); + PROCEDURE combo_extensionClick(Sender: TObject); + PROCEDURE panel_extensionResize(Sender: TObject); + FUNCTION GetValue(datatype:Byte; offset:LongWord):String; + PROCEDURE WriteStructureInfos(structinfoid:Integer); + PROCEDURE hexSelectionChanged(Sender: TObject); + PROCEDURE hexChange(Sender: TObject); + PROCEDURE panel_dataResize(Sender: TObject); + PROCEDURE structsClick(Sender: TObject); + PROCEDURE FormResize(Sender: TObject); + PROCEDURE ClearStructViewer; + PROCEDURE listClick(Sender: TObject); + PROCEDURE FormCloseQuery(Sender: TObject; var CanClose: Boolean); + PROCEDURE FormCreate(Sender: TObject); + PROCEDURE Recreatelist; + PRIVATE + PUBLIC + END; + +VAR + Form8: TForm8; + +IMPLEMENTATION +{$R *.dfm} +USES Unit1_main; +VAR + fileid:LongWord; + +FUNCTION IntToBin(value:Byte):String; + VAR i:Byte; + BEGIN + Result:=''; + FOR i:=7 DOWNTO 0 DO BEGIN + Result:=Result+IntToStr((value SHR i) AND $01); + END; + END; + +FUNCTION TForm8.GetValue(datatype:Byte; offset:LongWord):String; + VAR + data:Tdata; + i:Byte; + BEGIN + CASE datatype OF + 1: Result:=IntToStr(hex.data[offset]); + 2: Result:=IntToStr(hex.data[offset]+hex.data[offset+1]*256); + 3: Result:=IntToStr(hex.data[offset]+hex.data[offset+1]*256+hex.data[offset+2]*256*256); + 4: Result:=IntToStr(hex.data[offset]+hex.data[offset+1]*256+hex.data[offset+2]*256*256+hex.data[offset+3]*256*256*256); + 5: Result:='0x'+IntToHex(hex.data[offset],2); + 6: Result:='0x'+IntToHex(hex.data[offset]+hex.data[offset+1]*256,4); + 7: Result:='0x'+IntToHex(hex.data[offset]+hex.data[offset+1]*256+hex.data[offset+2]*256*256,6); + 8: Result:='0x'+IntToHex(hex.data[offset]+hex.data[offset+1]*256+hex.data[offset+2]*256*256+hex.data[offset+3]*256*256*256,8); + 9: BEGIN + SetLength(data,4); + data[0]:=hex.data[offset]; + data[1]:=hex.data[offset+1]; + data[2]:=hex.data[offset+2]; + data[3]:=hex.data[offset+3]; + Result:=FloatToStr(Decode_Float(data)); + END; + 10: Result:=IntToBin(hex.data[offset]); + 11..255: BEGIN + Result:=''; + FOR i:=1 TO datatype-10 DO BEGIN + IF hex.Data[offset+i-1]>=32 THEN + Result:=Result+Chr(hex.Data[offset+i-1]) + ELSE + Result:=Result+'.'; + END; + END; + END; + END; + +PROCEDURE TForm8.WriteStructureInfos(structinfoid:Integer); + VAR + i:Byte; + BEGIN + IF structinfoid>=0 THEN BEGIN + structs.Enabled:=True; + WITH structure_infos[structinfoid] DO BEGIN + Self.structs.RowCount:=Length(entries)+1; + FOR i:=1 TO Length(entries) DO BEGIN + Self.structs.Cells[0,i]:=entries[i-1].name; + Self.structs.Cells[1,i]:='0x'+IntToHex(entries[i-1].offset,6); + Self.structs.Cells[2,i]:=GetDataType(entries[i-1].datatype); + Self.structs.Cells[3,i]:=GetValue(entries[i-1].datatype,entries[i-1].offset); + Self.structs.Cells[4,i]:=entries[i-1].description; + END; + END; + END; + END; + +PROCEDURE TForm8.Recreatelist; + VAR + i:LongWord; + exts:TStringList; + BEGIN + combo_extension.Items.Clear; + combo_extension.Items.Add('_All files_ ('{+IntToStr(dat_header.Files)}+')'); + exts:=GetExtensionsList; + FOR i:=0 TO High(exts) DO + combo_extension.Items.Add(exts[i]); + combo_extension.ItemIndex:=0; + combo_extensionClick(Self); + END; + +PROCEDURE TForm8.FormCreate(Sender: TObject); + BEGIN + Self.Caption:=''; + fileid:=0; + structs.ColCount:=5; + structs.RowCount:=2; + structs.FixedRows:=1; + structs.Cells[0,0]:='Name'; + structs.Cells[1,0]:='Offset'; + structs.Cells[2,0]:='Type'; + structs.Cells[3,0]:='Value'; + structs.Cells[4,0]:='Description'; + structs.ColWidths[0]:=75; + structs.ColWidths[1]:=60; + structs.ColWidths[2]:=75; + structs.ColWidths[3]:=75; + Self.panel_dataResize(Self); + END; + +FUNCTION TForm8.Save:Boolean; + VAR + mem:TMemoryStream; + data:Tdata; + BEGIN + CASE MessageBox(Self.Handle,PChar('Save changes to file '+dat_files[fileid].FileName+'?'),PChar('Data changed...'),MB_YESNOCANCEL) OF + IDYES: BEGIN + mem:=TMemoryStream.Create; + hex.SaveToStream(mem); + mem.Seek(0,soFromBeginning); + SetLength(data,mem.Size); + mem.Read(data[0],mem.Size); + mem.Free; + UpdateDatFile(fileid,data); + Result:=True; + END; + IDNO: Result:=True; + IDCANCEL: BEGIN + Result:=False; + END; + END; + END; + +PROCEDURE TForm8.FormCloseQuery(Sender: TObject; var CanClose: Boolean); + BEGIN + IF hex.Modified THEN BEGIN + IF NOT Save THEN CanClose:=False; + END; + END; + +PROCEDURE TForm8.listClick(Sender: TObject); + VAR + mem:TMemoryStream; + data:Tdata; + i:LongWord; + BEGIN + IF hex.Modified THEN BEGIN + IF NOT Save THEN BEGIN + FOR i:=0 TO list.Count-1 DO BEGIN + IF StrToInt(MidStr(list.Items.Strings[i],1,5))=fileid THEN BEGIN + list.ItemIndex:=i; + Exit; + END; + END; + END; + END; + Self.ClearStructViewer; + fileid:=StrToInt(MidStr(list.Items.Strings[list.ItemIndex],1,5)); + data:=LoadDatFile(fileid); + IF Length(data)>0 THEN BEGIN + mem:=TMemoryStream.Create; + mem.Write(data[0],Length(data)); + mem.Seek(0,soFromBeginning); + hex.LoadFromStream(mem); + mem.Free; + WriteStructureInfos(GetStructureInfoId(dat_files[fileid].Extension)); + END; + END; + +PROCEDURE TForm8.ClearStructViewer; + VAR + x:Word; + BEGIN + structs.RowCount:=2; + FOR x:=0 TO structs.ColCount-1 DO structs.Cells[x,1]:=''; + structs.Enabled:=False; + END; + +PROCEDURE TForm8.FormResize(Sender: TObject); + BEGIN + IF Self.Width>=650 THEN BEGIN + END ELSE Self.Width:=650; + IF Self.Height>=450 THEN BEGIN + END ELSE Self.Height:=450; + END; + +PROCEDURE TForm8.structsClick(Sender: TObject); + VAR + offset:LongWord; + length:Byte; + BEGIN + IF structs.Row>0 THEN BEGIN + offset:=structure_infos[GetStructureInfoId(dat_files[fileid].extension)].entries[structs.Row-1].offset; + length:=GetTypeDataLength(structure_infos[GetStructureInfoId(dat_files[fileid].extension)].entries[structs.Row-1].datatype); + hex.SelStart:=offset; + hex.SelEnd:=offset+length-1; +{ IF structs.Cells[structs.Col,0]='Value' THEN + IF structure_infos[GetStructureInfoId(dat_files[fileid].Extension)].entries[structs.Row-1].datatype<=10 THEN + structs.Options:=structs.Options+[goEditing] + ELSE + structs.Options:=structs.Options-[goEditing]; +} END; + END; + +PROCEDURE TForm8.panel_dataResize(Sender: TObject); + BEGIN + structs.ColWidths[4]:=structs.Width-structs.ColWidths[0]-structs.ColWidths[1]-structs.ColWidths[2]-structs.ColWidths[3]-28; + END; + +PROCEDURE TForm8.hexChange(Sender: TObject); + BEGIN + IF hex.DataSize>0 THEN + WriteStructureInfos(GetStructureInfoId(dat_files[fileid].Extension)); + END; + +PROCEDURE TForm8.hexSelectionChanged(Sender: TObject); + VAR + selstart:Integer; + i,j:Word; + BEGIN + FOR i:=1 TO structs.RowCount-1 DO BEGIN + FOR j:=0 TO structs.ColCount-1 DO BEGIN + structs.CellColors[j,i]:=clWhite; + structs.CellFontColors[j,i]:=clBlack; + END; + END; + IF hex.DataSize>0 THEN BEGIN + selstart:=hex.SelStart; + IF GetStructureInfoId(dat_files[fileid].Extension)>=0 THEN BEGIN + WITH structure_infos[GetStructureInfoId(dat_files[fileid].Extension)] DO BEGIN + FOR i:=0 TO High(entries) DO BEGIN + IF ((selstart-entries[i].offset)=0) THEN BEGIN + FOR j:=0 TO structs.ColCount-1 DO BEGIN + structs.CellColors[j,i+1]:=clBlue; + structs.CellFontColors[j,i+1]:=clWhite; + END; + structs.Row:=i+1; + END; + END; + END; + END; + END; + END; + +PROCEDURE TForm8.panel_extensionResize(Sender: TObject); + BEGIN + combo_extension.Width:=panel_extension.Width-5; + END; + +PROCEDURE TForm8.combo_extensionClick(Sender: TObject); + VAR + Extension:String[4]; + files:TStringList; + i:LongWord; + BEGIN + Extension:=MidStr(combo_extension.Items.Strings[combo_extension.ItemIndex],1,4); + list.Items.Clear; + IF Extension='_All' THEN + files:=GetFilesList('','',True) + ELSE + files:=GetFilesList(extension,'',True); + IF Length(files)>0 THEN + FOR i:=0 TO High(files) DO + list.Items.Add(files[i]); + END; + +PROCEDURE TForm8.FormClose(Sender: TObject; var Action: TCloseAction); + BEGIN + Action:=caFree; + Form1.close_window(Self.Name); + END; + +PROCEDURE TForm8.panel_imexportResize(Sender: TObject); + BEGIN + btn_import.Width:=panel_imexport.Width-8; + btn_export.Width:=panel_imexport.Width-8; + END; + +PROCEDURE TForm8.btn_exportClick(Sender: TObject); + BEGIN + saved.Filter:='Files of matching extension (*.'+dat_files[fileid].Extension+')|*.'+dat_files[fileid].Extension+'|All files|*.*'; + saved.DefaultExt:=dat_files[fileid].Extension; + IF saved.Execute THEN BEGIN + ExportDatFile(fileid,saved.FileName); + END; + END; + +PROCEDURE TForm8.btn_importClick(Sender: TObject); + VAR + data:Tdata; + fs:TFileStream; + BEGIN + opend.Filter:='Files of matching extension (*.'+dat_files[fileid].Extension+')|*.'+dat_files[fileid].Extension+'|All files|*.*'; + IF opend.Execute THEN BEGIN + fs:=TFileStream.Create(opend.FileName,fmOpenRead); + IF fs.Size<>dat_files[fileid].size THEN BEGIN + ShowMessage('Can''t import '+ExtractFilename(opend.FileName)+ + ', file has to have same size as file in .dat.'+CrLf+ + 'Size of file in .dat: '+FormatFileSize(dat_files[fileid].size)+CrLf+ + 'Size of chosen file: '+FormatFileSize(fs.Size)); + END ELSE BEGIN + SetLength(data,fs.Size); + fs.Read(data[0],fs.Size); + fs.Free; + fs:=TFileStream.Create(dat_filename,fmOpenReadWrite); + fs.Seek(dat_files[fileid].dataddr,soFromBeginning); + fs.Write(data[0],Length(data)); + END; + fs.Free; + listClick(Self); + END; + END; + +PROCEDURE TForm8.FormActivate(Sender: TObject); + BEGIN + Form1.SetActiveWindow(Self.Name); + END; +{ +PROCEDURE TForm8.structsKeyPress(Sender: TObject; VAR Key: Char); + VAR + dt:Byte; + BEGIN + IF structs.EditorMode THEN BEGIN + dt:=structure_infos[GetStructureInfoId(dat_files[fileid].Extension)].entries[structs.Row-1].datatype; + CASE dt OF + 1..4: BEGIN + IF NOT (Key IN [#8,#13,#27,'0'..'9']) THEN Key:=#0; + END; + 5..8: BEGIN + IF NOT (Key IN [#8,#13,#27,'0'..'9','A'..'F','a'..'f']) THEN Key:=#0; + IF Key IN ['a'..'f'] THEN Key:=UpCase(Key); + IF NOT (Key IN [#8,#13,#27]) AND ( Length(structs.Cells[structs.Col,structs.Row])>=2*(dt-4) ) THEN Key:=#0; + END; + 9: BEGIN + IF (Key IN ['.']) AND (Pos('.',structs.Cells[structs.Col,structs.Row])>0) THEN Key:=#0; + IF NOT (Key IN [#8,#13,#27,'0'..'9','.','-']) THEN Key:=#0; + END; + 10: BEGIN + IF NOT (Key IN [#8,#13,#27,'0'..'1']) THEN Key:=#0; + IF NOT (Key IN [#8,#13,#27]) AND ( Length(structs.Cells[structs.Col,structs.Row])>=8 ) THEN Key:=#0; + END; + END; + END; + END; + +PROCEDURE TForm8.structsSetEditText(Sender: TObject; ACol, ARow: Integer; CONST Value: string); + BEGIN + IF NOT TWrapGrid(Sender).EditorMode THEN + ShowMessage('['+IntToStr(ACol)+'|'+IntToStr(ARow)+']='+Value); + END; + +PROCEDURE TForm8.structsGetEditText(Sender: TObject; ACol, ARow: Integer; var Value: string); + BEGIN + IF structs.EditorMode THEN + ShowMessage('EditorMode - '+Value) + ELSE + ShowMessage('NOT EditorMode - '+Value); + END; +} +END. Index: /oup/releases/0.20a/Unit9_data_structures.pas =================================================================== --- /oup/releases/0.20a/Unit9_data_structures.pas (revision 21) +++ /oup/releases/0.20a/Unit9_data_structures.pas (revision 21) @@ -0,0 +1,113 @@ +UNIT Unit9_data_structures; +INTERFACE +USES SysUtils; + +TYPE + Tstructure_entry=RECORD + name:String; + offset:LongWord; + datatype:Byte; // 1..4: Integer[1..4] dec; 5..8: Integer[1..4] hex; 9: float; 10: bitset; 11+: string[1+] + description:String; + END; + Tstructure_info=RECORD + extension:String; + typedesc:String; + entries:Array OF Tstructure_entry; + END; + Tstructures=Array OF Tstructure_info; + +VAR + structure_infos:Tstructures; + + +FUNCTION GetDataType(typeid:Byte):String; +FUNCTION GetStructureInfoId(ext:String):Integer; +FUNCTION GetTypeDataLength(datatype:Byte):Byte; + + + +IMPLEMENTATION + +FUNCTION GetTypeDataLength(datatype:Byte):Byte; + BEGIN + CASE datatype OF + 1..4: Result:=datatype; + 5..8: Result:=datatype-4; + 9: Result:=4; + 10: Result:=1; + 11..255: Result:=datatype-10; + END; + END; + + +FUNCTION GetStructureInfoId(ext:String):Integer; + VAR + i:Integer; + BEGIN + FOR i:=0 TO High(structure_infos) DO BEGIN + IF structure_infos[i].extension=ext THEN BEGIN + Result:=i; + Exit; + END; + END; + Result:=-1; + END; + + +FUNCTION GetDataType(typeid:Byte):String; + BEGIN + CASE typeid OF + 1..4: Result:='Int'+IntToStr(typeid*8); + 5..8: Result:='Int'+IntToStr((typeid-4)*8); + 9: Result:='Float'; + 10: Result:='BitSet'; + 11..255: Result:='String('+IntToStr(typeid-10)+')'; + END; + END; + + +PROCEDURE AddEntry(_ext:String; _name:String; _offset:LongWord; _datatype:Byte; _description:String); + VAR + sid:Integer; + BEGIN + sid:=GetStructureInfoId(_ext); + IF sid>=0 THEN BEGIN + WITH structure_infos[sid] DO BEGIN + SetLength(entries,Length(entries)+1); + WITH entries[High(entries)] DO BEGIN + name:=_name; + offset:=_offset; + datatype:=_datatype; + description:=_description; + END; + END; + END; + END; + + +PROCEDURE AddExtension(_ext:String; _typedesc:String); + BEGIN + IF GetStructureInfoId(_ext)<0 THEN BEGIN + SetLength(structure_infos,Length(structure_infos)+1); + WITH structure_infos[High(structure_infos)] DO BEGIN + extension:='TXMP'; + typedesc:='Texture'; + END; + END; + END; + + +BEGIN + AddExtension('TXMP','Texture'); + AddEntry('TXMP','ID',$00,4,'ID of this file'); + AddEntry('TXMP','LevelID',$04,8,'ID of the level this file is in'); + AddEntry('TXMP','FileName',$08,138,''); + AddEntry('TXMP','Fading',$88,10,'Fading-Bitset'); + AddEntry('TXMP','Depth',$89,10,'Depth-Bitset'); + AddEntry('TXMP','Width',$8C,2,'x-resolution of image'); + AddEntry('TXMP','Height',$8E,2,'y-resolution of image'); + AddEntry('TXMP','Storetype',$90,10,'Storetype-Bitset'); + AddEntry('TXMP','TXAN-Link',$94,8,'Link to the TXAN-file (if this TXMP is the first image of an animation)'); + AddEntry('TXMP','TXMP-Link',$98,8,'Link to another TXMP-file'); + AddEntry('TXMP','Raw-Link',$9C,8,'Address of the image data in the .raw-file'); +END. Index: /oup/releases/0.21a/OniUnPacker.bdsproj =================================================================== --- /oup/releases/0.21a/OniUnPacker.bdsproj (revision 21) +++ /oup/releases/0.21a/OniUnPacker.bdsproj (revision 21) @@ -0,0 +1,171 @@ + + + + + + + + + + + + OniUnPacker.dpr + + + 7.0 + + + 8 + 0 + 1 + 1 + 0 + 0 + 1 + 1 + 1 + 0 + 0 + 1 + 0 + 1 + 1 + 1 + 0 + 0 + 0 + 0 + 0 + 1 + 0 + 1 + 1 + 1 + True + True + WinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE; + + False + + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + False + False + False + True + True + True + + + 0 + 0 + 1 + False + False + False + 16384 + 1048576 + 4194304 + + + + + + + + + xmlrtl;rtl;vcl;vclie;inet;inetdbbde;inetdbxpress;vclx;IndySystem;IndyCore;dbrtl;dsnap;soaprtl;IndyProtocols;bdertl;vcldbx;vcldb;webdsnap;websnap;vclactnband;GridPackd2005;TWrapGrid;Package1;A406_R70;CoolTrayIcon_D6plus + + + False + + + + + + False + + + + + + False + + + False + False + 1 + 0 + 0 + 0 + False + False + False + False + False + 1031 + 1252 + + + + + 1.0.0.0 + + + + + + 1.0.0.0 + + + (untitled) + Borland Web Wizard Package + + + Index: /oup/releases/0.21a/OniUnPacker.cfg =================================================================== --- /oup/releases/0.21a/OniUnPacker.cfg (revision 21) +++ /oup/releases/0.21a/OniUnPacker.cfg (revision 21) @@ -0,0 +1,38 @@ +-$A8 +-$B- +-$C+ +-$D+ +-$E- +-$F- +-$G+ +-$H+ +-$I+ +-$J- +-$K- +-$L+ +-$M- +-$N+ +-$O+ +-$P+ +-$Q- +-$R- +-$S- +-$T- +-$U- +-$V+ +-$W- +-$X+ +-$YD +-$Z1 +-cg +-AWinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE; +-H+ +-W+ +-M +-$M16384,1048576 +-K$00400000 +-LE"C:\Dokumente und Einstellungen\Administrator\Eigene Dateien\Borland Studio Projects\Bpl" +-LN"C:\Dokumente und Einstellungen\Administrator\Eigene Dateien\Borland Studio Projects\Bpl" +-w-UNSAFE_TYPE +-w-UNSAFE_CODE +-w-UNSAFE_CAST Index: /oup/releases/0.21a/OniUnPacker.dpr =================================================================== --- /oup/releases/0.21a/OniUnPacker.dpr (revision 21) +++ /oup/releases/0.21a/OniUnPacker.dpr (revision 21) @@ -0,0 +1,26 @@ +PROGRAM OniUnPacker; +uses + Forms, + Unit1_main in 'Unit1_main.pas' {Form1}, + Unit2_functions in 'Unit2_functions.pas', + Unit3_data in 'Unit3_data.pas', + Unit4_Exporters in 'Unit4_Exporters.pas', + Unit5_preview in 'Unit5_preview.pas' {Form5}, + Unit6_imgfuncs in 'Unit6_imgfuncs.pas', + Unit7_txmpreplace in 'Unit7_txmpreplace.pas' {Form7}, + Unit8_binedit in 'Unit8_binedit.pas' {Form8}, + Unit9_data_structures in 'Unit9_data_structures.pas', + Unit10_leveldb in 'Unit10_leveldb.pas' {Form10}, + Unit11_extractor in 'Unit11_extractor.pas' {Form11}, + Unit12_ValueEdit in 'Unit12_ValueEdit.pas' {Form12}; + +{$R *.res} + +BEGIN + Application.Initialize; + Application.Title:='Oni Un/Packer'; + Application.CreateForm(TForm1, Form1); + Application.CreateForm(TForm10, Form10); + Application.CreateForm(TForm12, Form12); + Application.Run; +END. Index: /oup/releases/0.21a/SQLite3.pas =================================================================== --- /oup/releases/0.21a/SQLite3.pas (revision 21) +++ /oup/releases/0.21a/SQLite3.pas (revision 21) @@ -0,0 +1,120 @@ +unit SQLite3; + +{ + Simplified interface for SQLite. + Updated for Sqlite 3 by Tim Anderson (tim@itwriting.com) + Note: NOT COMPLETE for version 3, just minimal functionality + Adapted from file created by Pablo Pissanetzky (pablo@myhtpc.net) + which was based on SQLite.pas by Ben Hochstrasser (bhoc@surfeu.ch) +} + +interface + +const +// Return values for sqlite3_exec() and sqlite3_step() + +SQLITE_OK = 0; // Successful result +SQLITE_ERROR = 1; // SQL error or missing database +SQLITE_INTERNAL = 2; // An internal logic error in SQLite +SQLITE_PERM = 3 ; // Access permission denied +SQLITE_ABORT = 4; // Callback routine requested an abort +SQLITE_BUSY = 5; // The database file is locked +SQLITE_LOCKED = 6; // A table in the database is locked +SQLITE_NOMEM = 7; // A malloc() failed +SQLITE_READONLY = 8; // Attempt to write a readonly database +SQLITE_INTERRUPT = 9; // Operation terminated by sqlite3_interrupt() +SQLITE_IOERR = 10; // Some kind of disk I/O error occurred +SQLITE_CORRUPT = 11; // The database disk image is malformed +SQLITE_NOTFOUND = 12; // (Internal Only) Table or record not found +SQLITE_FULL = 13; // Insertion failed because database is full +SQLITE_CANTOPEN = 14; // Unable to open the database file +SQLITE_PROTOCOL = 15; // Database lock protocol error +SQLITE_EMPTY = 16; // Database is empty +SQLITE_SCHEMA = 17; // The database schema changed +SQLITE_TOOBIG = 18; // Too much data for one row of a table +SQLITE_CONSTRAINT = 19; // Abort due to contraint violation +SQLITE_MISMATCH = 20; // Data type mismatch +SQLITE_MISUSE = 21; // Library used incorrectly +SQLITE_NOLFS = 22; // Uses OS features not supported on host +SQLITE_AUTH = 23; // Authorization denied +SQLITE_FORMAT = 24; // Auxiliary database format error +SQLITE_RANGE = 25; // 2nd parameter to sqlite3_bind out of range +SQLITE_NOTADB = 26; // File opened that is not a database file +SQLITE_ROW = 100; // sqlite3_step() has another row ready +SQLITE_DONE = 101; // sqlite3_step() has finished executing + +SQLITE_INTEGER = 1; +SQLITE_FLOAT = 2; +SQLITE_TEXT = 3; +SQLITE_BLOB = 4; +SQLITE_NULL = 5; + +type +TSQLiteDB = Pointer; +TSQLiteResult = ^PChar; +TSQLiteStmt = Pointer; + +function SQLite3_Open (dbname: PChar; var db: TSqliteDB): integer; cdecl; external 'sqlite3.dll' name 'sqlite3_open'; +function SQLite3_Close (db: TSQLiteDB): integer; cdecl; external 'sqlite3.dll' name 'sqlite3_close'; +function SQLite3_Exec (db: TSQLiteDB; SQLStatement: PChar; CallbackPtr: Pointer; Sender: TObject; var ErrMsg: PChar): integer; cdecl; external 'sqlite3.dll' name 'sqlite3_exec'; +function SQLite3_Version (): PChar; cdecl; external 'sqlite3.dll' name 'sqlite3_libversion'; +function SQLite3_ErrMsg (db: TSQLiteDB): PChar; cdecl; external 'sqlite3.dll' name 'sqlite3_errmsg'; +function SQLite3_ErrCode (db: TSQLiteDB): integer; cdecl; external 'sqlite3.dll' name 'sqlite3_errcode'; +procedure SQlite3_Free (P: PChar); cdecl; external 'sqlite3.dll' name 'sqlite3_free'; +function SQLite3_GetTable (db: TSQLiteDB; SQLStatement: PChar; var ResultPtr: TSQLiteResult; var RowCount: Cardinal; var ColCount: Cardinal; var ErrMsg: PChar): integer; cdecl; external 'sqlite3.dll' name 'sqlite3_get_table'; +procedure SQLite3_FreeTable (Table:TSQLiteResult ); cdecl; external 'sqlite3.dll' name 'sqlite3_free_table'; +function SQLite3_Complete (P: PChar): boolean; cdecl; external 'sqlite3.dll' name 'sqlite3_complete'; +function SQLite3_LastInsertRowID(db: TSQLiteDB): int64; cdecl; external 'sqlite3.dll' name 'sqlite3_last_insert_rowid'; +procedure SQLite3_Interrupt (db: TSQLiteDB); cdecl; external 'sqlite3.dll' name 'sqlite3_interrupt'; +procedure SQLite3_BusyHandler (db: TSQLiteDB; CallbackPtr: Pointer; Sender: TObject); cdecl; external 'sqlite3.dll' name'sqlite3_busy_handler' ; +procedure SQLite3_BusyTimeout (db: TSQLiteDB; TimeOut: integer); cdecl; external 'sqlite3.dll' name 'sqlite3_busy_timeout'; +function SQLite3_Changes (db: TSQLiteDB): integer; cdecl; external 'sqlite3.dll' name 'sqlite3_changes'; +function SQLite3_TotalChanges (db: TSQLiteDB): integer; cdecl; external 'sqlite3.dll' name 'sqlite3_total_changes'; +function SQLite3_Prepare (db: TSQLiteDB; SQLStatement: PChar; nBytes: integer; var hStmt: TSqliteStmt; var pzTail: PChar): integer; cdecl; external 'sqlite3.dll' name 'sqlite3_prepare'; +function SQLite3_ColumnCount (hStmt: TSqliteStmt): integer; cdecl; external 'sqlite3.dll' name 'sqlite3_column_count'; +function Sqlite3_ColumnName (hStmt: TSqliteStmt; ColNum: integer): pchar; cdecl; external 'sqlite3.dll' name 'sqlite3_column_name'; +function Sqlite3_ColumnDeclType (hStmt: TSqliteStmt; ColNum: integer): pchar; cdecl; external 'sqlite3.dll' name 'sqlite3_column_decltype'; +function Sqlite3_Step (hStmt: TSqliteStmt): integer; cdecl; external 'sqlite3.dll' name 'sqlite3_step'; +function SQLite3_DataCount (hStmt: TSqliteStmt): integer; cdecl; external 'sqlite3.dll' name 'sqlite3_data_count'; + +function Sqlite3_ColumnBlob (hStmt: TSqliteStmt; ColNum: integer):pointer; cdecl; external 'sqlite3.dll' name 'sqlite3_column_blob'; +function Sqlite3_ColumnBytes (hStmt: TSqliteStmt; ColNum: integer): integer; cdecl; external 'sqlite3.dll' name 'sqlite3_column_bytes'; +function Sqlite3_ColumnDouble (hStmt: TSqliteStmt; ColNum: integer): double; cdecl; external 'sqlite3.dll' name 'sqlite3_column_double'; +function Sqlite3_ColumnInt (hStmt: TSqliteStmt; ColNum: integer): integer; cdecl; external 'sqlite3.dll' name 'sqlite3_column_int'; +function Sqlite3_ColumnText (hStmt: TSqliteStmt; ColNum: integer): pchar; cdecl; external 'sqlite3.dll' name 'sqlite3_column_text'; +function Sqlite3_ColumnType (hStmt: TSqliteStmt; ColNum: integer): integer; cdecl; external 'sqlite3.dll' name 'sqlite3_column_type'; + // function Sqlite3_ColumnInt64 (hStmt: TSqliteStmt; ColNum: integer): SqliteInt64; cdecl; external 'sqlite3.dll' name 'sqlite3_column_int64'; +function SQLite3_Finalize (hStmt: TSqliteStmt): integer; cdecl; external 'sqlite3.dll' name 'sqlite3_finalize'; +function SQLite3_Reset (hStmt: TSqliteStmt): integer; cdecl; external 'sqlite3.dll' name 'sqlite3_reset'; + +// +// In the SQL strings input to sqlite3_prepare() and sqlite3_prepare16(), +// one or more literals can be replace by a wildcard "?" or ":N:" where +// N is an integer. These value of these wildcard literals can be set +// using the routines listed below. +// +// In every case, the first parameter is a pointer to the sqlite3_stmt +// structure returned from sqlite3_prepare(). The second parameter is the +// index of the wildcard. The first "?" has an index of 1. ":N:" wildcards +// use the index N. +// + // The fifth parameter to sqlite3_bind_blob(), sqlite3_bind_text(), and + //sqlite3_bind_text16() is a destructor used to dispose of the BLOB or +//text after SQLite has finished with it. If the fifth argument is the +// special value SQLITE_STATIC, then the library assumes that the information +// is in static, unmanaged space and does not need to be freed. If the +// fifth argument has the value SQLITE_TRANSIENT, then SQLite makes its +// own private copy of the data. +// +// The sqlite3_bind_* routine must be called before sqlite3_step() after +// an sqlite3_prepare() or sqlite3_reset(). Unbound wildcards are interpreted +// as NULL. +// + +function SQLite3_BindBlob(hStmt: TSqliteStmt; ParamNum: integer; +ptrData: pointer; numBytes: integer; ptrDestructor: pointer): integer; +cdecl; external 'sqlite3.dll' name 'sqlite3_bind_blob'; + +implementation + +end. Index: /oup/releases/0.21a/SQLiteTable3.pas =================================================================== --- /oup/releases/0.21a/SQLiteTable3.pas (revision 21) +++ /oup/releases/0.21a/SQLiteTable3.pas (revision 21) @@ -0,0 +1,885 @@ +unit SQLiteTable3; + +{ + Simple classes for using SQLite's exec and get_table. + + TSQLiteDatabase wraps the calls to open and close an SQLite database. + It also wraps SQLite_exec for queries that do not return a result set + + TSQLiteTable wraps sqlite_get_table. + It allows accessing fields by name as well as index and can step through a + result set with the Next procedure. + + Adapted by Tim Anderson (tim@itwriting.com) + Originally created by Pablo Pissanetzky (pablo@myhtpc.net) +} + +interface + +uses + Windows, SQLite3, Classes, Sysutils; + +const + dtStr = 0; + dtInt = 1; + dtBool = 2; + dtNumeric = 3; + dtBlob = 4; + +type + + ESQLiteException = class(Exception) + private + public + end; + + TSQLiteTable = class; + + TSQLiteDatabase = class + private + fDB: TSQLiteDB; + fInTrans: Boolean; + procedure RaiseError(s: string; SQL: string); + + public + constructor Create(const FileName: string); + destructor Destroy; override; + function GetTable(const SQL: string): TSQLiteTable; + procedure ExecSQL(const SQL: string); + procedure UpdateBlob(const SQL: string; BlobData: TStream); + procedure BeginTransaction; + procedure Commit; + procedure Rollback; + function TableExists(TableName: string): boolean; + function GetLastInsertRowID: int64; + + published + property isTransactionOpen: boolean read fInTrans; + + end; + + TSQLiteTable = class + private + fResults: TList; + fRowCount: Cardinal; + fColCount: Cardinal; + fCols: TStringList; + fColTypes: TList; + fRow: Cardinal; + + function GetFields(I: Integer): string; + function GetEOF: Boolean; + function GetBOF: Boolean; + function GetColumns(I: Integer): string; + function GetFieldByName(FieldName: string): string; + function GetFieldIndex(FieldName: string): integer; + function GetCount: Integer; + function GetCountResult: Integer; + + + public + constructor Create(DB: TSQLiteDatabase; const SQL: string); + destructor Destroy; override; + function FieldAsInteger(FieldName: string): integer; + function FieldAsBool(FieldName: string): boolean; + function FieldAsBlob(FieldName: string): TMemoryStream; + function FieldAsBlobText(FieldName: string): string; + function FieldIsNull(FieldName: string): boolean; + function FieldAsString(FieldName: string): string; + function FieldAsDouble(FieldName: string): double; +{ function FieldAsInteger(I: integer): integer; + function FieldAsBool(I: integer): boolean; + function FieldAsBlob(I: Integer): TMemoryStream; + function FieldAsBlobText(I: Integer): string; + function FieldIsNull(I: integer): boolean; + function FieldAsString(I: Integer): string; + function FieldAsDouble(I: Integer): double; +} function Next: Boolean; + function Previous: Boolean; + property EOF: Boolean read GetEOF; + property BOF: Boolean read GetBOF; + property Fields[I: Integer]: string read GetFields; + property FieldByName[FieldName: string]: string read GetFieldByName; + property FieldIndex[FieldName: string]: integer read GetFieldIndex; + property Columns[I: Integer]: string read GetColumns; + property ColCount: Cardinal read fColCount; + property RowCount: Cardinal read fRowCount; + property Row: Cardinal read fRow; + function MoveFirst: boolean; + function MoveLast: boolean; + + + property Count: Integer read GetCount; + + // The property CountResult is used when you execute count(*) queries. + // It returns 0 if the result set is empty or the value of the + // first field as an integer. + property CountResult: Integer read GetCountResult; + end; + + +procedure DisposePointer(ptr: pointer); cdecl; + +implementation + +uses + strutils; + + +procedure DisposePointer(ptr: pointer); cdecl; +begin + + if assigned(ptr) then + begin freemem(ptr) end; + +end; + +//------------------------------------------------------------------------------ +// TSQLiteDatabase +//------------------------------------------------------------------------------ + +constructor TSQLiteDatabase.Create(const FileName: string); +var + Msg: pchar; + iResult: integer; +begin + inherited Create; + + self.fInTrans := false; + + Msg := nil; + try + iResult := SQLite3_Open(PChar(FileName), Fdb); + + if iResult <> SQLITE_OK then + begin + if Assigned(Fdb) then + begin + Msg := Sqlite3_ErrMsg(Fdb); + raise ESqliteException.CreateFmt('Failed to open database "%s" : %s', [FileName, Msg]); + end + else + begin raise ESqliteException.CreateFmt('Failed to open database "%s" : unknown error', [FileName]) end; + end; + + //set a few configs + self.ExecSQL('PRAGMA SYNCHRONOUS=NORMAL;'); + + //this pragma not recommended and may disappear in future + //sqlite versions + //self.ExecSQL('PRAGMA full_column_names = 1;'); + + finally + if Assigned(Msg) then + begin SQLite3_Free(Msg) end; + end; + + +end; + + +//.............................................................................. + +destructor TSQLiteDatabase.Destroy; +begin + + if self.fInTrans then + begin self.ExecSQL('ROLLBACK;') end; //assume rollback + + if Assigned(fDB) then + begin SQLite3_Close(fDB) end; + + inherited; +end; + +function TSQLiteDatabase.GetLastInsertRowID: int64; +begin + result := Sqlite3_LastInsertRowID(self.fDB); +end; + +//.............................................................................. + +procedure TSQLiteDatabase.RaiseError(s: string; SQL: string); +//look up last error and raise and exception with an appropriate message +var + Msg: PChar; +begin + + Msg := nil; + + if sqlite3_errcode(self.fDB) <> SQLITE_OK then + Msg := sqlite3_errmsg(self.fDB); + + IF Pos('DROP TABLE ',SQL)>0 THEN Exit; + + if Msg <> nil then + raise ESqliteException.CreateFmt(s + ' "%s" : %s', [SQL, Msg]) + else + raise ESqliteException.CreateFmt(s, [SQL, 'No message']); + +end; + +procedure TSQLiteDatabase.ExecSQL(const SQL: string); +var + Stmt: TSQLiteStmt; + NextSQLStatement: Pchar; + iStepResult: integer; +begin + try + + if Sqlite3_Prepare(self.fDB, PChar(SQL), -1, Stmt, NextSQLStatement) <> SQLITE_OK then + begin RaiseError('Error executing SQL', SQL) end; + + if (Stmt = nil) then + begin RaiseError('Could not prepare SQL statement', SQL) end; + + iStepResult := Sqlite3_step(Stmt); + + if (iStepResult <> SQLITE_DONE) then + begin RaiseError('Error executing SQL statement', SQL) end; + + finally + + if Assigned(Stmt) then + begin Sqlite3_Finalize(stmt) end; + + end; +end; + +procedure TSQLiteDatabase.UpdateBlob(const SQL: string; BlobData: TStream); +var + iSize: integer; + ptr: pointer; + Stmt: TSQLiteStmt; + Msg: Pchar; + NextSQLStatement: Pchar; + iStepResult: integer; + iBindResult: integer; +begin +//expects SQL of the form 'UPDATE MYTABLE SET MYFIELD = ? WHERE MYKEY = 1' + + if pos('?', SQL) = 0 then + begin RaiseError('SQL must include a ? parameter', SQL) end; + + Msg := nil; + try + + if Sqlite3_Prepare(self.fDB, PChar(SQL), -1, Stmt, NextSQLStatement) <> SQLITE_OK then + begin RaiseError('Could not prepare SQL statement', SQL) end; + + if (Stmt = nil) then + begin RaiseError('Could not prepare SQL statement', SQL) end; + +//now bind the blob data + iSize := BlobData.size; + + GetMem(ptr, iSize); + + if (ptr = nil) then + begin raise ESqliteException.CreateFmt('Error getting memory to save blob', [SQL, 'Error']) end; + + BlobData.position := 0; + BlobData.Read(ptr^, iSize); + + iBindResult := SQLite3_BindBlob(stmt, 1, ptr, iSize, @DisposePointer); + + if iBindResult <> SQLITE_OK then + begin RaiseError('Error binding blob to database', SQL) end; + + iStepResult := Sqlite3_step(Stmt); + + if (iStepResult <> SQLITE_DONE) then + begin RaiseError('Error executing SQL statement', SQL) end; + + finally + + if Assigned(Stmt) then + begin Sqlite3_Finalize(stmt) end; + + if Assigned(Msg) then + begin SQLite3_Free(Msg) end; + end; + +end; + +//.............................................................................. + +function TSQLiteDatabase.GetTable(const SQL: string): TSQLiteTable; +begin + Result := TSQLiteTable.Create(Self, SQL); +end; + +procedure TSQLiteDatabase.BeginTransaction; +begin + if not self.fInTrans then + begin + self.ExecSQL('BEGIN TRANSACTION;'); + self.fInTrans := true; + end + else + begin raise ESqliteException.Create('Transaction already open') end; +end; + +procedure TSQLiteDatabase.Commit; +begin + self.ExecSQL('COMMIT;'); + self.fInTrans := false; +end; + +procedure TSQLiteDatabase.Rollback; +begin + self.ExecSQL('ROLLBACK;'); + self.fInTrans := false; +end; + +function TSQLiteDatabase.TableExists(TableName: string): boolean; +var + sql: string; + ds: TSqliteTable; +begin +//returns true if table exists in the database + sql := 'select [sql] from sqlite_master where [type] = ''table'' and lower(name) = ''' + lowercase(TableName) + ''' '; + + try + + ds := self.GetTable(sql); + + result := (ds.Count > 0); + + finally + + freeandnil(ds); + + end; + +end; + + +//------------------------------------------------------------------------------ +// TSQLiteTable +//------------------------------------------------------------------------------ + +constructor TSQLiteTable.Create(DB: TSQLiteDatabase; const SQL: string); +var + Stmt: TSQLiteStmt; + NextSQLStatement: Pchar; + iStepResult: integer; + + ptr: pointer; + iNumBytes: integer; + thisBlobValue: TMemoryStream; + thisStringValue: pstring; + thisBoolValue: pBoolean; + thisDoubleValue: pDouble; + thisIntValue: pInteger; + thisColType: pInteger; + i: integer; + DeclaredColType: Pchar; + ActualColType: integer; + ptrValue: Pchar; + +begin + + try + + self.fRowCount := 0; + self.fColCount := 0; + +//if there are several SQL statements in SQL, NextSQLStatment points to the +//beginning of the next one. Prepare only prepares the first SQL statement. + + if Sqlite3_Prepare(Db.fDB, PChar(SQL), -1, Stmt, NextSQLStatement) <> SQLITE_OK then + begin Db.RaiseError('Error executing SQL', SQL) end; + + if (Stmt = nil) then + begin Db.RaiseError('Could not prepare SQL statement', SQL) end; + + iStepResult := Sqlite3_step(Stmt); + + while (iStepResult <> SQLITE_DONE) do + begin + + case iStepResult of + SQLITE_ROW: + begin + + inc(fRowCount); + + if (fRowCount = 1) then + begin + //get data types + fCols := TStringList.Create; + fCols.CaseSensitive := False; + fColTypes := TList.Create; + + fColCount := SQLite3_ColumnCount(stmt); + + for i := 0 to Pred(fColCount) do + begin + fCols.Add(Sqlite3_ColumnName(stmt, i)); + end; + + for i := 0 to Pred(fColCount) do + begin + + new(thisColType); + DeclaredColType := Sqlite3_ColumnDeclType(stmt, i); + + if DeclaredColType = nil then begin + //use the actual column type instead + //seems to be needed for last_insert_rowid + thisColType^ := Sqlite3_ColumnType(stmt, i); + end else begin + DeclaredColType := strupper(DeclaredColType); + + if DeclaredColType = 'INTEGER' then + begin thisColType^ := dtInt end + else + if DeclaredColType = 'BOOLEAN' then + begin thisColType^ := dtBool end + else + if (DeclaredColType = 'NUMERIC') or (DeclaredColType = 'FLOAT') or (DeclaredColType = 'DOUBLE') then + begin thisColType^ := dtNumeric end + else + if DeclaredColType = 'BLOB' then + begin thisColType^ := dtBlob end + else + begin thisColType^ := dtStr end; + end; + + fColTypes.Add(thiscoltype); + end; + + fResults := TList.Create; + + end; + + //get column values + for i := 0 to Pred(ColCount) do + begin + + ActualColType := Sqlite3_ColumnType(stmt, i); + if (ActualColType = SQLITE_NULL) then + begin fResults.Add(nil) end + else + begin + if pInteger(fColTypes[i])^ = dtInt then + begin + new(thisintvalue); + thisintvalue^ := Sqlite3_ColumnInt(stmt, i); + fResults.Add(thisintvalue); + end + else + if pInteger(fColTypes[i])^ = dtBool then + begin + new(thisboolvalue); + thisboolvalue^ := not (Sqlite3_ColumnInt(stmt, i) = 0); + fResults.Add(thisboolvalue); + end + else + if pInteger(fColTypes[i])^ = dtNumeric then + begin + new(thisdoublevalue); + thisdoublevalue^ := Sqlite3_ColumnDouble(stmt, i); + fResults.Add(thisdoublevalue); + end + else + if pInteger(fColTypes[i])^ = dtBlob then + begin + iNumBytes := Sqlite3_ColumnBytes(stmt, i); + + if iNumBytes = 0 then + begin thisblobvalue := nil end + else + begin + thisblobvalue := TMemoryStream.Create; + thisblobvalue.position := 0; + ptr := Sqlite3_ColumnBlob(stmt, i); + thisblobvalue.writebuffer(ptr^, iNumBytes); + end; + fResults.Add(thisblobvalue); + + end + else + begin + new(thisstringvalue); + ptrValue := Sqlite3_ColumnText(stmt, i); + setstring(thisstringvalue^, ptrvalue, strlen(ptrvalue)); + fResults.Add(thisstringvalue); + end; + end; + + end; + + + + end; + + SQLITE_BUSY: + begin raise ESqliteException.CreateFmt('Could not prepare SQL statement', [SQL, 'SQLite is Busy']) end; + else + begin Db.RaiseError('Could not retrieve data', SQL) end; + end; + + iStepResult := Sqlite3_step(Stmt); + + end; + + fRow := 0; + + finally + if Assigned(Stmt) then + begin Sqlite3_Finalize(stmt) end; + end; + +end; + +//.............................................................................. + +destructor TSQLiteTable.Destroy; +var i: integer; + iColNo: integer; +begin + + + if Assigned(fResults) then + begin for i := 0 to fResults.Count - 1 do + begin + //check for blob type + iColNo := (i mod fColCount); + case pInteger(self.fColTypes[iColNo])^ of + dtBlob: + begin + TMemoryStream(fResults[i]).free; + end; + dtStr: + begin + if fResults[i] <> nil then + begin + setstring(string(fResults[i]^), nil, 0); + dispose(fResults[i]); + end; + end; + else + begin + dispose(fResults[i]) + end; + end; + end; + fResults.Free; + end; + + if Assigned(fCols) then + begin fCols.Free end; + + if Assigned(fColTypes) then + begin for i := 0 to fColTypes.Count - 1 do + begin + dispose(fColTypes[i]); + end end; + fColTypes.Free; + inherited; + end; + +//.............................................................................. + +function TSQLiteTable.GetColumns(I: Integer): string; +begin + Result := fCols[I]; +end; + +//.............................................................................. + +function TSQLiteTable.GetCountResult: Integer; +begin + if not EOF then + begin Result := StrToInt(Fields[0]) end + else + begin Result := 0 end; +end; + +function TSQLiteTable.GetCount: Integer; +begin + Result := FRowCount; +end; + +//.............................................................................. + +function TSQLiteTable.GetEOF: Boolean; +begin + Result := fRow >= fRowCount; +end; + +function TSQLiteTable.GetBOF: Boolean; +begin + Result := fRow <= 0; +end; + +//.............................................................................. + +function TSQLiteTable.GetFieldByName(FieldName: string): string; +begin + Result := GetFields(self.GetFieldIndex(FieldName)); +end; + +function TSQLiteTable.GetFieldIndex(FieldName: string): integer; +begin + + if (fCols = nil) then + begin + raise ESqliteException.Create('Field ' + fieldname + ' Not found. Empty dataset'); + exit; + end; + + if (fCols.count = 0) then + begin + raise ESqliteException.Create('Field ' + fieldname + ' Not found. Empty dataset'); + exit; + end; + + result := fCols.IndexOf(FieldName); + + if (result < 0) then + begin raise ESqliteException.Create('Field not found in dataset: ' + fieldname) end; + +end; + +//.............................................................................. + +function TSQLiteTable.GetFields(I: Integer): string; +var + thisvalue: pstring; + ptr: pointer; + thisboolvalue: pBoolean; + thistype: integer; +begin + Result := ''; + + if EOF then + begin raise ESqliteException.Create('Table is at End of File') end; + +//integer and boolean types are not stored in the resultset +//as strings, so they should be retrieved using the type-specific +//methods + + thistype := pInteger(self.fColTypes[I])^; + + if (thistype = dtInt) or (thistype = dtNumeric) or (thistype = dtBlob) then + begin + ptr := self.fResults[(self.frow * self.fColCount) + I]; + + if ptr <> nil then + begin + raise ESqliteException.Create('Use the specific methods for integer, numeric or blob fields'); + end; + + end + else + if pInteger(self.fColTypes[I])^ = dtBool then + begin + thisboolvalue := self.fResults[(self.frow * self.fColCount) + I]; + if thisboolvalue <> nil then + begin if thisboolvalue^ then + begin result := '1' end + else + begin result := '0' end end; + end + + else + + begin + + thisvalue := self.fResults[(self.frow * self.fColCount) + I]; + if (thisvalue <> nil) then + begin Result := thisvalue^ end + else + begin Result := '' end; //return empty string + end; + +end; + +function TSqliteTable.FieldAsBlob(FieldName: string): TMemoryStream; +var + i: Integer; +begin + + if EOF then + begin raise ESqliteException.Create('Table is at End of File') end; + + i:=Self.FieldIndex[FieldName]; + + if (self.fResults[(self.frow * self.fColCount) + I] = nil) then + begin result := nil end + else + if pInteger(self.fColTypes[I])^ = dtBlob then + begin result := TMemoryStream(self.fResults[(self.frow * self.fColCount) + I]) end + else + begin raise ESqliteException.Create('Not a Blob field') end; +end; + +function TSqliteTable.FieldAsBlobText(FieldName: string): string; +var + MemStream: TMemoryStream; + Buffer: PChar; +begin + result := ''; + + MemStream := self.FieldAsBlob(FieldName); + + if MemStream <> nil then + begin if MemStream.Size > 0 then + begin + MemStream.position := 0; + + Buffer := stralloc(MemStream.Size + 1); + MemStream.readbuffer(Buffer[0], MemStream.Size); + (Buffer + MemStream.Size)^ := chr(0); + SetString(Result, Buffer, MemStream.size); + strdispose(Buffer); + end end; + +end; + + +function TSqliteTable.FieldAsInteger(FieldName: string): integer; +var + i: Integer; +begin + + if EOF then + begin raise ESqliteException.Create('Table is at End of File') end; + + i:=Self.FieldIndex[FieldName]; + + if (self.fResults[(self.frow * self.fColCount) + I] = nil) then + begin result := 0 end + else + if pInteger(self.fColTypes[I])^ = dtInt then + begin result := pInteger(self.fResults[(self.frow * self.fColCount) + I])^ end + else + if pInteger(self.fColTypes[I])^ = dtNumeric then + begin result := trunc(strtofloat(pString(self.fResults[(self.frow * self.fColCount) + I])^)) end + else + begin raise ESqliteException.Create('Not an integer or numeric field') end; + +end; + +function TSqliteTable.FieldAsDouble(FieldName: string): double; +var + i: Integer; +begin + + if EOF then + begin raise ESqliteException.Create('Table is at End of File') end; + + i:=Self.FieldIndex[FieldName]; + + if (self.fResults[(self.frow * self.fColCount) + I] = nil) then + begin result := 0 end + else + if pInteger(self.fColTypes[I])^ = dtInt then + begin result := pInteger(self.fResults[(self.frow * self.fColCount) + I])^ end + else + if pInteger(self.fColTypes[I])^ = dtNumeric then + begin result := pDouble(self.fResults[(self.frow * self.fColCount) + I])^ end + else + begin raise ESqliteException.Create('Not an integer or numeric field') end; + +end; + +function TSqliteTable.FieldAsBool(FieldName: string): boolean; +var + i: Integer; +begin + + if EOF then + begin raise ESqliteException.Create('Table is at End of File') end; + + i:=Self.FieldIndex[FieldName]; + + if (self.fResults[(self.frow * self.fColCount) + I] = nil) then + begin result := false end + else + if pInteger(self.fColTypes[I])^ = dtBool then + begin result := pBoolean(self.fResults[(self.frow * self.fColCount) + I])^ end + else + begin raise ESqliteException.Create('Not a boolean field') end; +end; + +function TSqliteTable.FieldAsString(FieldName: string): string; +var + i: Integer; +begin + + if EOF then + begin raise ESqliteException.Create('Table is at End of File') end; + + i:=Self.FieldIndex[FieldName]; + + if (self.fResults[(self.frow * self.fColCount) + I] = nil) then + begin result := '' end + else + begin result := self.GetFields(I) end; + +end; + +function TSqliteTable.FieldIsNull(FieldName: string): boolean; +var + thisvalue: pointer; + i: Integer; +begin + + if EOF then + begin raise ESqliteException.Create('Table is at End of File') end; + + i:=Self.FieldIndex[FieldName]; + + thisvalue := self.fResults[(self.frow * self.fColCount) + I]; + result := (thisvalue = nil); +end; + +//.............................................................................. + +function TSQLiteTable.Next: boolean; +begin + result := false; + if not EOF then + begin + Inc(fRow); + result := true; + end; +end; + +function TSQLiteTable.Previous: boolean; +begin + result := false; + if not BOF then + begin + Dec(fRow); + result := true; + end; +end; + +function TSQLiteTable.MoveFirst: boolean; +begin + result := false; + if self.fRowCount > 0 then + begin + fRow := 0; + result := true; + end; +end; + +function TSQLiteTable.MoveLast: boolean; +begin + result := false; + if self.fRowCount > 0 then + begin + fRow := fRowCount - 1; + result := true; + end; +end; + + +end. + Index: /oup/releases/0.21a/Unit10_leveldb.dfm =================================================================== --- /oup/releases/0.21a/Unit10_leveldb.dfm (revision 21) +++ /oup/releases/0.21a/Unit10_leveldb.dfm (revision 21) @@ -0,0 +1,61 @@ +object Form10: TForm10 + Left = 0 + Top = 0 + BorderStyle = bsNone + Caption = 'Creating DB' + ClientHeight = 90 + ClientWidth = 401 + Color = clBtnFace + Font.Charset = DEFAULT_CHARSET + Font.Color = clWindowText + Font.Height = -11 + Font.Name = 'Tahoma' + Font.Style = [] + OldCreateOrder = False + Position = poScreenCenter + PixelsPerInch = 96 + TextHeight = 13 + object group_progress: TGroupBox + Left = 0 + Top = 0 + Width = 400 + Height = 89 + Caption = 'Progress ...' + TabOrder = 0 + object lbl_progress: TLabel + Left = 2 + Top = 32 + Width = 396 + Height = 17 + Align = alTop + AutoSize = False + end + object lbl_estimation: TLabel + Left = 2 + Top = 49 + Width = 396 + Height = 17 + Align = alTop + AutoSize = False + Caption = 'Estimated finishing time:' + end + object progress: TProgressBar + Left = 2 + Top = 15 + Width = 396 + Height = 17 + Align = alTop + Smooth = True + TabOrder = 0 + end + object btn_abortok: TButton + Left = 3 + Top = 64 + Width = 60 + Height = 22 + Caption = 'Abort...' + TabOrder = 1 + OnClick = btn_abortokClick + end + end +end Index: /oup/releases/0.21a/Unit10_leveldb.pas =================================================================== --- /oup/releases/0.21a/Unit10_leveldb.pas (revision 21) +++ /oup/releases/0.21a/Unit10_leveldb.pas (revision 21) @@ -0,0 +1,986 @@ +UNIT Unit10_leveldb; +INTERFACE +USES + Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, + Dialogs, ComCtrls, StdCtrls; + +TYPE + TForm10 = Class(TForm) + group_progress: TGroupBox; + progress: TProgressBar; + lbl_progress: TLabel; + btn_abortok: TButton; + lbl_estimation: TLabel; + PROCEDURE btn_abortokClick(Sender: TObject); + PRIVATE + PROCEDURE HandleFile(ext:String; fileid:LongWord; dir_dat2db:Boolean); + PROCEDURE stop_convert; + PUBLIC + PROCEDURE CreateDatabase(FileName:String); + END; + + +VAR + Form10: TForm10; + +IMPLEMENTATION +{$R *.dfm} +USES SQLiteTable3, Unit1_main, Unit2_functions, Unit3_data; +TYPE + THandler=PROCEDURE(fileid:LongWord; dir_dat2db:Boolean); + TConvertHandlers=RECORD + Ext:String[4]; + needed:Boolean; + Handler:THandler; + END; +VAR + ConvertHandlers:Array OF TConvertHandlers; + loaded_filename:String; + converting:Boolean=False; + abort:Boolean=False; + filestream:TFileStream; + dat_stream,mem:TMemoryStream; + +PROCEDURE TForm10.HandleFile; + VAR + i:Byte; + BEGIN + FOR i:=1 TO Length(ConvertHandlers) DO + IF UpperCase(ConvertHandlers[i].Ext)=UpperCase(ext) THEN + IF ConvertHandlers[i].needed THEN BEGIN + ConvertHandlers[i].Handler(fileid, dir_dat2db); + Break; + END ELSE + Break; + END; + +PROCEDURE TForm10.CreateDatabase(FileName:String); + VAR + i,j:LongWord; + temps,temps2:String; + data:Tdata; + absolutebegintime,begintime:Double; + step:Byte; + CONST + steps:Byte=4; + PROCEDURE DoStep(stepname:String); + BEGIN + Inc(step); + IF stepname<>'FIN' THEN + group_progress.Caption:='Creating DB (Step '+IntToStr(step)+'/'+IntToStr(steps)+': '+stepname+')' + ELSE + group_progress.Caption:='Creating DB (FINISHED)'; + END; + BEGIN + Form10.Visible:=True; + Form1.Visible:=False; + step:=0; + converting:=True; + abort:=False; + loaded_filename:=FileName; + btn_abortok.Caption:='&Abort...'; + btn_abortok.Default:=False; + + absolutebegintime:=Time; + + DB:=TSQLiteDatabase.Create(FileName); + DB.ExecSQL('PRAGMA synchronous = 0;'); + DB.ExecSQL('PRAGMA temp_store = 2;'); + DB.ExecSQL('DROP TABLE globals;'); + DB.ExecSQL('DROP TABLE linkmap;'); + DB.ExecSQL('DROP TABLE rawmap;'); + DB.ExecSQL('DROP TABLE datfiles;'); + DB.ExecSQL('DROP TABLE extlist;'); + DB.ExecSQL('VACUUM;'); + + DoStep('Creating tables'); + progress.Position:=0; + lbl_progress.Caption:=''; + lbl_estimation.Caption:='Estimated finishing time: unknown'; + Application.ProcessMessages; + + DB.ExecSQL('CREATE TABLE globals (id INTEGER PRIMARY KEY AUTOINCREMENT, name VARCHAR (20), value VARCHAR (50) );'); + DB.ExecSQL('CREATE TABLE linkmap (id INTEGER PRIMARY KEY AUTOINCREMENT, src_id INTEGER, src_link_offset INTEGER, target_id INTEGER );'); + DB.ExecSQL('CREATE TABLE rawmap (id INTEGER PRIMARY KEY AUTOINCREMENT, src_id INTEGER, src_link_offset INTEGER, data BLOB );'); + DB.ExecSQL('CREATE TABLE datfiles (id INTEGER PRIMARY KEY, extension VARCHAR(4), name VARCHAR(128), contenttype INTEGER, data BLOB );'); + DB.ExecSQL('CREATE TABLE extlist (id INTEGER PRIMARY KEY AUTOINCREMENT, ext VARCHAR(4), ident VARCHAR(16) );'); + + DB.ExecSQL('INSERT INTO globals (name,value) VALUES ("dbversion","'+dbversion+'");'); + SetLength(data,Length(dat_header.Ident)); + FOR i:=0 TO High(dat_header.Ident) DO data[i]:=dat_header.Ident[i]; + temps:=CreateHexString(data,True); + DB.ExecSQL('INSERT INTO globals (name,value) VALUES ("ident","'+temps+'");'); + data:=LoadDatFile(0); + i:=data[7]; + i:=i DIV 2; + DB.ExecSQL('INSERT INTO globals (name,value) VALUES ("lvl","'+IntToStr(i)+'");'); + + DoStep('Writing extensionslist'); + progress.Max:=dat_header.Extensions; + Application.ProcessMessages; + + FOR i:=0 TO dat_header.Extensions-1 DO BEGIN + SetLength(data,Length(dat_extensionsmap[i].Ident)); + FOR j:=0 TO High(dat_extensionsmap[i].Ident) DO data[j]:=dat_extensionsmap[i].Ident[j]; + temps:=CreateHexString(data,True); + temps2:=dat_extensionsmap[i].Extension[3]+dat_extensionsmap[i].Extension[2]+dat_extensionsmap[i].Extension[1]+dat_extensionsmap[i].Extension[0]; + DB.ExecSQL('INSERT INTO extlist (ext,ident) VALUES ("'+temps2+'","'+temps+'");'); + progress.Position:=i; + lbl_progress.Caption:='Extensions done: '+IntToStr(i)+'/'+IntToStr(dat_header.Extensions); + Application.ProcessMessages; + IF abort THEN BEGIN + stop_convert; + Exit; + END; + END; + lbl_progress.Caption:=''; + + DoStep('Loading .dat into memory'); + Application.ProcessMessages; + + progress.Position:=0; + lbl_progress.Caption:='Files done: '+IntToStr(0)+'/'+IntToStr(dat_header.Files); + lbl_estimation.Caption:='Estimated finishing time: unknown'; + + filestream:=TFileStream.Create(dat_filename, fmOpenRead); + dat_stream:=TMemoryStream.Create; + dat_stream.CopyFrom(filestream,0); + dat_stream.Seek(0,soFromBeginning); + filestream.Free; + + progress.Max:=dat_header.Files; + begintime:=Time; + DoStep('Writing .dat-fileslist'); + Application.ProcessMessages; + + FOR i:=0 TO dat_header.Files-1 DO BEGIN + DB.ExecSQL('INSERT INTO datfiles (id,extension,name,contenttype) VALUES ('+IntToStr(i)+',"'+dat_files[i].Extension+'","'+dat_files[i].Name+'","'+IntToHex(dat_files[i].FileType,8)+'");'); + IF (dat_files[i].FileType AND $02)=0 THEN BEGIN + dat_stream.Seek(dat_files[i].DatAddr,soFromBeginning); + mem:=TMemoryStream.Create; + mem.CopyFrom(dat_stream,dat_files[i].Size); + mem.Seek(0,soFromBeginning); + DB.UpdateBlob('UPDATE datfiles SET data = ? WHERE id='+IntToStr(i)+';',mem); + HandleFile(dat_files[i].Extension,i,True); + mem.Free; + END; + IF ( (i MOD 50)=0 ) AND (i>=100) THEN + lbl_estimation.Caption:='Estimated finishing time: '+TimeToStr((Time-begintime)/i*dat_header.Files+begintime); + IF (i MOD 5)=0 THEN BEGIN + progress.Position:=i; + lbl_progress.Caption:='Files done: '+IntToStr(i)+'/'+IntToStr(dat_header.Files); + Application.ProcessMessages; + END; + IF abort THEN BEGIN + stop_convert; + Exit; + END; + END; + progress.Position:=dat_header.Files; + lbl_progress.Caption:='Files done: '+IntToStr(dat_header.Files)+'/'+IntToStr(dat_header.Files); + lbl_estimation.Caption:='FINISHED (duration: '+TimeToStr(Time-absolutebegintime)+')'; + + DoStep('FIN'); + btn_abortok.Caption:='&OK'; + btn_abortok.Default:=True; + + loaded_filename:=''; + converting:=False; + dat_stream.Free; + DB.Free; + END; + +PROCEDURE TForm10.stop_convert; + BEGIN + btn_abortok.Caption:='&Close'; + btn_abortok.Default:=True; + converting:=False; + lbl_estimation.Caption:='ABORTED'; + group_progress.Caption:='Creating DB (ABORTED)'; + IF MessageBox(Self.Handle, PChar('Delete the unfinished DB-file?'), PChar('Delete file?'), MB_YESNO)=IDYES THEN BEGIN + DB.Free; + DeleteFile(loaded_filename); + END; + END; + +PROCEDURE TForm10.btn_abortokClick(Sender: TObject); + BEGIN + IF converting THEN BEGIN + IF MessageBox(Self.Handle, PChar('Do you really want to cancel the convert-progress?'), PChar('Warning: Converting'), MB_YESNO)=IDYES THEN + abort:=True; + END ELSE BEGIN + Form10.Visible:=False; + Form1.Visible:=True; + END; + END; + + +PROCEDURE LoadFilePart(offset,size:LongWord; target:Pointer); + BEGIN + mem.Seek(offset,soFromBeginning); + mem.Read(target^,size); + END; + +PROCEDURE InsertDatLinkToDB(fileid:LongWord; offset:LongWord); + VAR + link:LongWord; + BEGIN + LoadFilePart(offset,4,@link); + IF link=0 THEN + link:=$FFFFFFFF + ELSE + link:=link DIV 256; + DB.ExecSQL('INSERT INTO linkmap (src_id,src_link_offset,target_id) VALUES ('+IntToStr(fileid)+','+IntToStr(offset)+','+IntToStr(link)+');'); + END; + +PROCEDURE InsertRawFileToDB(fileid:LongWord; src_offset,raw_addr,size:LongWord); + VAR + localmem:TMemoryStream; + BEGIN + localmem:=TMemoryStream.Create; + filestream:=TFileStream.Create(raw_filename,fmOpenRead); + filestream.Seek(raw_addr,soFromBeginning); + localmem.CopyFrom(filestream,size); + filestream.Free; + DB.ExecSQL('INSERT INTO rawmap (src_id,src_link_offset) VALUES ('+IntToStr(fileid)+','+IntToStr(src_offset)+');'); + DB.UpdateBlob('UPDATE rawmap SET data = ? WHERE src_id='+IntToStr(fileid),localmem); + localmem.Free; + END; + + + +PROCEDURE AGDB(fileid:LongWord; dir_dat2db:Boolean); + VAR + link:LongWord; + links:LongWord; + i:LongWord; + BEGIN + IF dir_dat2db THEN BEGIN + LoadFilePart($1C,4,@links); + links:=links*2; + FOR i:=0 TO links-1 DO BEGIN + LoadFilePart($20+i*4,4,@link); + InsertRawFileToDB(fileid,$20+i*4,link,1{????????????????????????????????}); + END; + END ELSE BEGIN + END; + END; +PROCEDURE AKEV(fileid:LongWord; dir_dat2db:Boolean); + VAR + i:LongWord; + BEGIN + IF dir_dat2db THEN BEGIN + FOR i:=0 TO 16 DO InsertDatLinkToDB(fileid,$8+i*4); + END ELSE BEGIN + END; + END; +PROCEDURE AKOT(fileid:LongWord; dir_dat2db:Boolean); + VAR + i:LongWord; + BEGIN + IF dir_dat2db THEN BEGIN + FOR i:=0 TO 4 DO InsertDatLinkToDB(fileid,$8+i*4); + END ELSE BEGIN + END; + END; +PROCEDURE BINA(fileid:LongWord; dir_dat2db:Boolean); + VAR + link:LongWord; + datasize:LongWord; + BEGIN + IF dir_dat2db THEN BEGIN + LoadFilePart($0C,4,@link); + LoadFilePart($08,4,@datasize); + InsertRawFileToDB(fileid,$0C,link,datasize); + END ELSE BEGIN + END; + END; +PROCEDURE CBPI(fileid:LongWord; dir_dat2db:Boolean); + VAR + i:LongWord; + BEGIN + IF dir_dat2db THEN BEGIN + FOR i:=0 TO 56 DO InsertDatLinkToDB(fileid,$8+i*4); + END ELSE BEGIN + END; + END; +PROCEDURE CBPM(fileid:LongWord; dir_dat2db:Boolean); + VAR + i:LongWord; + BEGIN + IF dir_dat2db THEN BEGIN + FOR i:=0 TO 18 DO InsertDatLinkToDB(fileid,$8+i*4); + END ELSE BEGIN + END; + END; +PROCEDURE CONS(fileid:LongWord; dir_dat2db:Boolean); + VAR + i:LongWord; + BEGIN + IF dir_dat2db THEN BEGIN + FOR i:=0 TO 1 DO InsertDatLinkToDB(fileid,$24+i*4); + END ELSE BEGIN + END; + END; +PROCEDURE CRSA(fileid:LongWord; dir_dat2db:Boolean); + VAR + packages:LongWord; + i:LongWord; + BEGIN + IF dir_dat2db THEN BEGIN + LoadFilePart($14,4,@packages); + IF packages>0 THEN + FOR i:=0 TO packages-1 DO InsertDatLinkToDB(fileid,$20+i*1100+$A0); + END ELSE BEGIN + END; + END; +PROCEDURE DOOR(fileid:LongWord; dir_dat2db:Boolean); + BEGIN + IF dir_dat2db THEN BEGIN + InsertDatLinkToDB(fileid,$08); + InsertDatLinkToDB(fileid,$10); + END ELSE BEGIN + END; + END; +PROCEDURE DPGE(fileid:LongWord; dir_dat2db:Boolean); + BEGIN + IF dir_dat2db THEN BEGIN + InsertDatLinkToDB(fileid,$40); + END ELSE BEGIN + END; + END; +PROCEDURE HPGE(fileid:LongWord; dir_dat2db:Boolean); + BEGIN + IF dir_dat2db THEN BEGIN + InsertDatLinkToDB(fileid,$0C); + END ELSE BEGIN + END; + END; +PROCEDURE IGHH(fileid:LongWord; dir_dat2db:Boolean); + BEGIN + IF dir_dat2db THEN BEGIN + InsertDatLinkToDB(fileid,$24); + InsertDatLinkToDB(fileid,$28); + END ELSE BEGIN + END; + END; +PROCEDURE IGPA(fileid:LongWord; dir_dat2db:Boolean); + VAR + links:LongWord; + i:LongWord; + BEGIN + IF dir_dat2db THEN BEGIN + LoadFilePart($1C,4,@links); + IF links>0 THEN + FOR i:=0 TO links-1 DO InsertDatLinkToDB(fileid,$20+i*4); + END ELSE BEGIN + END; + END; +PROCEDURE IGPG(fileid:LongWord; dir_dat2db:Boolean); + VAR + i:LongWord; + BEGIN + IF dir_dat2db THEN BEGIN + FOR i:=0 TO 1 DO InsertDatLinkToDB(fileid,$1C+i*4); + END ELSE BEGIN + END; + END; +PROCEDURE IGSA(fileid:LongWord; dir_dat2db:Boolean); + VAR + links:LongWord; + i:LongWord; + BEGIN + IF dir_dat2db THEN BEGIN + LoadFilePart($1C,4,@links); + IF links>0 THEN + FOR i:=0 TO links-1 DO InsertDatLinkToDB(fileid,$20+i*4); + END ELSE BEGIN + END; + END; +PROCEDURE IMPT(fileid:LongWord; dir_dat2db:Boolean); + BEGIN + IF dir_dat2db THEN BEGIN + InsertDatLinkToDB(fileid,$10); + END ELSE BEGIN + END; + END; +PROCEDURE IPGE(fileid:LongWord; dir_dat2db:Boolean); + BEGIN + IF dir_dat2db THEN BEGIN + InsertDatLinkToDB(fileid,$0C); + END ELSE BEGIN + END; + END; +PROCEDURE KEYI(fileid:LongWord; dir_dat2db:Boolean); + VAR + i:LongWord; + BEGIN + IF dir_dat2db THEN BEGIN + FOR i:=0 TO 9 DO InsertDatLinkToDB(fileid,$08+i*4); + END ELSE BEGIN + END; + END; +PROCEDURE M3GA(fileid:LongWord; dir_dat2db:Boolean); + VAR + links:LongWord; + i:LongWord; + BEGIN + IF dir_dat2db THEN BEGIN + LoadFilePart($1C,4,@links); + IF links>0 THEN + FOR i:=0 TO links-1 DO InsertDatLinkToDB(fileid,$20+i*4); + END ELSE BEGIN + END; + END; +PROCEDURE M3GM(fileid:LongWord; dir_dat2db:Boolean); + VAR + i:LongWord; + BEGIN + IF dir_dat2db THEN BEGIN + FOR i:=0 TO 6 DO InsertDatLinkToDB(fileid,$0C+i*4); + END ELSE BEGIN + END; + END; +PROCEDURE MTRL(fileid:LongWord; dir_dat2db:Boolean); + BEGIN + IF dir_dat2db THEN BEGIN + InsertDatLinkToDB(fileid,$10); + END ELSE BEGIN + END; + END; +PROCEDURE OBOA(fileid:LongWord; dir_dat2db:Boolean); + VAR + packages:Word; + i:LongWord; + BEGIN + IF dir_dat2db THEN BEGIN + LoadFilePart($1E,2,@packages); + IF packages>0 THEN + FOR i:=0 TO packages-1 DO InsertDatLinkToDB(fileid,$20+i*240); + END ELSE BEGIN + END; + END; +PROCEDURE OFGA(fileid:LongWord; dir_dat2db:Boolean); + VAR + packages:LongWord; + i:LongWord; + BEGIN + IF dir_dat2db THEN BEGIN + LoadFilePart($1C,4,@packages); + IF packages>0 THEN + FOR i:=0 TO packages-1 DO InsertDatLinkToDB(fileid,$20+i*12+$04); + END ELSE BEGIN + END; + END; +PROCEDURE ONCC(fileid:LongWord; dir_dat2db:Boolean); + VAR + i:LongWord; + BEGIN + IF dir_dat2db THEN BEGIN + END ELSE BEGIN + END; + END; +PROCEDURE ONCV(fileid:LongWord; dir_dat2db:Boolean); + BEGIN + IF dir_dat2db THEN BEGIN + InsertDatLinkToDB(fileid,$08); + END ELSE BEGIN + END; + END; +PROCEDURE ONLV(fileid:LongWord; dir_dat2db:Boolean); + VAR + i:LongWord; + BEGIN + IF dir_dat2db THEN BEGIN + FOR i:=0 TO 5 DO InsertDatLinkToDB(fileid,$48+i*4); + FOR i:=0 TO 5 DO InsertDatLinkToDB(fileid,$64+i*4); + InsertDatLinkToDB(fileid,$300); + END ELSE BEGIN + END; + END; +PROCEDURE ONOA(fileid:LongWord; dir_dat2db:Boolean); + VAR + packages:LongWord; + i:LongWord; + BEGIN + IF dir_dat2db THEN BEGIN + LoadFilePart($1C,4,@packages); + IF packages>0 THEN + FOR i:=0 TO packages-1 DO InsertDatLinkToDB(fileid,$20+i*8+$04); + END ELSE BEGIN + END; + END; +PROCEDURE ONSK(fileid:LongWord; dir_dat2db:Boolean); + BEGIN + IF dir_dat2db THEN BEGIN + InsertDatLinkToDB(fileid,$08); + InsertDatLinkToDB(fileid,$0C); + InsertDatLinkToDB(fileid,$10); + InsertDatLinkToDB(fileid,$14); + InsertDatLinkToDB(fileid,$18); + InsertDatLinkToDB(fileid,$20); + InsertDatLinkToDB(fileid,$44); + END ELSE BEGIN + END; + END; +PROCEDURE ONVL(fileid:LongWord; dir_dat2db:Boolean); + VAR + packages:LongWord; + i:LongWord; + BEGIN + IF dir_dat2db THEN BEGIN + LoadFilePart($1C,4,@packages); + IF packages>0 THEN + FOR i:=0 TO packages-1 DO InsertDatLinkToDB(fileid,$20+i*4); + END ELSE BEGIN + END; + END; +PROCEDURE ONWC(fileid:LongWord; dir_dat2db:Boolean); + BEGIN + IF dir_dat2db THEN BEGIN + InsertDatLinkToDB(fileid,$28); + InsertDatLinkToDB(fileid,$34); + InsertDatLinkToDB(fileid,$54); + InsertDatLinkToDB(fileid,$58); + InsertDatLinkToDB(fileid,$5C); + InsertDatLinkToDB(fileid,$60); + InsertDatLinkToDB(fileid,$6FC); + InsertDatLinkToDB(fileid,$700); + END ELSE BEGIN + END; + END; +PROCEDURE OPGE(fileid:LongWord; dir_dat2db:Boolean); + BEGIN + IF dir_dat2db THEN BEGIN + InsertDatLinkToDB(fileid,$1C); + END ELSE BEGIN + END; + END; +PROCEDURE OSBD(fileid:LongWord; dir_dat2db:Boolean); + VAR + link:LongWord; + datasize:LongWord; + BEGIN + IF dir_dat2db THEN BEGIN + LoadFilePart($08,4,@datasize); + LoadFilePart($0C,4,@link); + InsertRawFileToDB(fileid,$0C,link,datasize); + END ELSE BEGIN + END; + END; +PROCEDURE PSPC(fileid:LongWord; dir_dat2db:Boolean); + BEGIN + IF dir_dat2db THEN BEGIN + InsertDatLinkToDB(fileid,$50); + END ELSE BEGIN + END; + END; +PROCEDURE PSPL(fileid:LongWord; dir_dat2db:Boolean); + VAR + packages:LongWord; + i:LongWord; + BEGIN + IF dir_dat2db THEN BEGIN + LoadFilePart($1C,4,@packages); + IF packages>0 THEN + FOR i:=0 TO packages-1 DO InsertDatLinkToDB(fileid,$24+i*8); + END ELSE BEGIN + END; + END; +PROCEDURE PSUI(fileid:LongWord; dir_dat2db:Boolean); + VAR + i:LongWord; + BEGIN + IF dir_dat2db THEN BEGIN + FOR i:=0 TO 43 DO InsertDatLinkToDB(fileid,$08+i*4); + END ELSE BEGIN + END; + END; +PROCEDURE SNDD(fileid:LongWord; dir_dat2db:Boolean); + VAR + link:LongWord; + datasize:LongWord; + BEGIN + IF dir_dat2db THEN BEGIN + LoadFilePart($40,4,@datasize); + LoadFilePart($44,4,@link); + InsertRawFileToDB(fileid,$44,link,datasize); + END ELSE BEGIN + END; + END; +PROCEDURE SUBT(fileid:LongWord; dir_dat2db:Boolean); + VAR + baselink,link:LongWord; + links:LongWord; + i,j:LongWord; + data:Tdata; + BEGIN + IF dir_dat2db THEN BEGIN + LoadFilePart($18,4,@baselink); + LoadFilePart($1C,4,@links); + IF links>0 THEN BEGIN + FOR i:=0 TO links-1 DO BEGIN + LoadFilePart($20+i*4,4,@link); + SetLength(data,1024); + LoadRawFile(fileid,baselink+link,1024,@data[0]); + FOR j:=0 TO 1024 DO BEGIN + IF (data[j]=$00) OR (j=1024) THEN BEGIN + IF j<1024 THEN + InsertRawFileToDB(fileid,$20+i*4,baselink+link,j) + ELSE + ShowMessage('Error: Didn''t find message-end-marker...'); + Break; + END; + END; + END; + END; + END ELSE BEGIN + END; + END; +PROCEDURE STNA(fileid:LongWord; dir_dat2db:Boolean); + VAR + packages:Word; + i:LongWord; + BEGIN + IF dir_dat2db THEN BEGIN + LoadFilePart($1E,2,@packages); + IF packages>0 THEN + FOR i:=0 TO packages-1 DO InsertDatLinkToDB(fileid,$20+i*4); + END ELSE BEGIN + END; + END; +PROCEDURE TRAC(fileid:LongWord; dir_dat2db:Boolean); + VAR + packages:Word; + i:LongWord; + BEGIN + IF dir_dat2db THEN BEGIN + InsertDatLinkToDB(fileid,$18); + LoadFilePart($1E,2,@packages); + IF packages>0 THEN + FOR i:=0 TO packages-1 DO InsertDatLinkToDB(fileid,$20+i*12+8); + END ELSE BEGIN + END; + END; +PROCEDURE TRAM(fileid:LongWord; dir_dat2db:Boolean); + VAR + i:Byte; + link:LongWord; + BEGIN + IF dir_dat2db THEN BEGIN + FOR i:=0 TO 11 DO BEGIN + LoadFilePart($0C+i*4,4,@link); + InsertRawFileToDB(fileid,$0C+i*4,link,1{????????????????????????????????}); + END; + LoadFilePart($13C,4,@link); + InsertRawFileToDB(fileid,$13C,link,1{????????????????????????????????}); + END ELSE BEGIN + END; + END; +PROCEDURE TRAS(fileid:LongWord; dir_dat2db:Boolean); + BEGIN + IF dir_dat2db THEN BEGIN + InsertDatLinkToDB(fileid,$08); + END ELSE BEGIN + END; + END; +PROCEDURE TRBS(fileid:LongWord; dir_dat2db:Boolean); + VAR + i:LongWord; + BEGIN + IF dir_dat2db THEN BEGIN + FOR i:=0 TO 4 DO InsertDatLinkToDB(fileid,$08+i*4); + END ELSE BEGIN + END; + END; +PROCEDURE TRCM(fileid:LongWord; dir_dat2db:Boolean); + VAR + i:LongWord; + BEGIN + IF dir_dat2db THEN BEGIN + FOR i:=0 TO 2 DO InsertDatLinkToDB(fileid,$5C+i*4); + END ELSE BEGIN + END; + END; +PROCEDURE TRGA(fileid:LongWord; dir_dat2db:Boolean); + VAR + i:LongWord; + packages:Word; + BEGIN + IF dir_dat2db THEN BEGIN + LoadFilePart($1E,2,@packages); + IF packages>0 THEN + FOR i:=0 TO packages-1 DO InsertDatLinkToDB(fileid,$20+i*4); + END ELSE BEGIN + END; + END; +PROCEDURE TRGE(fileid:LongWord; dir_dat2db:Boolean); + BEGIN + IF dir_dat2db THEN BEGIN + InsertDatLinkToDB(fileid,$20); + END ELSE BEGIN + END; + END; +PROCEDURE TRIG(fileid:LongWord; dir_dat2db:Boolean); + BEGIN + IF dir_dat2db THEN BEGIN + InsertDatLinkToDB(fileid,$18); + InsertDatLinkToDB(fileid,$24); + InsertDatLinkToDB(fileid,$28); + END ELSE BEGIN + END; + END; +PROCEDURE TRMA(fileid:LongWord; dir_dat2db:Boolean); + VAR + i:LongWord; + packages:Word; + BEGIN + IF dir_dat2db THEN BEGIN + LoadFilePart($1E,2,@packages); + IF packages>0 THEN + FOR i:=0 TO packages-1 DO InsertDatLinkToDB(fileid,$20+i*4); + END ELSE BEGIN + END; + END; +PROCEDURE TRSC(fileid:LongWord; dir_dat2db:Boolean); + VAR + i:LongWord; + packages:Word; + BEGIN + IF dir_dat2db THEN BEGIN + LoadFilePart($1E,2,@packages); + IF packages>0 THEN + FOR i:=0 TO packages-1 DO InsertDatLinkToDB(fileid,$20+i*4); + END ELSE BEGIN + END; + END; +PROCEDURE TSFF(fileid:LongWord; dir_dat2db:Boolean); + VAR + i:LongWord; + packages:LongWord; + BEGIN + IF dir_dat2db THEN BEGIN + LoadFilePart($1C,4,@packages); + IF packages>0 THEN + FOR i:=0 TO packages-1 DO InsertDatLinkToDB(fileid,$20+i*4); + END ELSE BEGIN + END; + END; +PROCEDURE TSFT(fileid:LongWord; dir_dat2db:Boolean); + BEGIN + IF dir_dat2db THEN BEGIN + InsertDatLinkToDB(fileid,$1C); + END ELSE BEGIN + END; + END; +PROCEDURE TURR(fileid:LongWord; dir_dat2db:Boolean); + BEGIN + IF dir_dat2db THEN BEGIN + InsertDatLinkToDB(fileid,$60); + InsertDatLinkToDB(fileid,$6C); + InsertDatLinkToDB(fileid,$74); + END ELSE BEGIN + END; + END; +PROCEDURE TXAN(fileid:LongWord; dir_dat2db:Boolean); + VAR + i:LongWord; + packages:LongWord; + BEGIN + IF dir_dat2db THEN BEGIN + LoadFilePart($1C,4,@packages); + IF packages>0 THEN + FOR i:=0 TO packages-1 DO InsertDatLinkToDB(fileid,$20+i*4); + END ELSE BEGIN + END; + END; +PROCEDURE TXMA(fileid:LongWord; dir_dat2db:Boolean); + VAR + i:LongWord; + packages:LongWord; + BEGIN + IF dir_dat2db THEN BEGIN + LoadFilePart($1C,4,@packages); + IF packages>0 THEN + FOR i:=0 TO packages-1 DO InsertDatLinkToDB(fileid,$20+i*4); + END ELSE BEGIN + END; + END; +PROCEDURE TXMB(fileid:LongWord; dir_dat2db:Boolean); + VAR + i:LongWord; + packages:LongWord; + BEGIN + IF dir_dat2db THEN BEGIN + LoadFilePart($1C,4,@packages); + IF packages>0 THEN + FOR i:=0 TO packages-1 DO InsertDatLinkToDB(fileid,$20+i*4); + END ELSE BEGIN + END; + END; +PROCEDURE TXMP(fileid:LongWord; dir_dat2db:Boolean); + VAR + link:LongWord; + x,y:Word; + storetype:Byte; + datasize:LongWord; + BEGIN + IF dir_dat2db THEN BEGIN + LoadFilePart($8C,SizeOf(x),@x); + LoadFilePart($8E,SizeOf(y),@y); + LoadFilePart($90,SizeOf(storetype),@storetype); + LoadFilePart($9C,4,@link); + CASE storetype OF + 0,1,2: datasize:=x*y*2; + 8: datasize:=x*y*4; + 9: datasize:=x*y DIV 2; + END; + InsertRawFileToDB(fileid,$9C,link,datasize); + InsertDatLinkToDB(fileid,$94); + InsertDatLinkToDB(fileid,$98); + END ELSE BEGIN + END; + END; +PROCEDURE TXTC(fileid:LongWord; dir_dat2db:Boolean); + BEGIN + IF dir_dat2db THEN BEGIN + InsertDatLinkToDB(fileid,$08); + END ELSE BEGIN + END; + END; +PROCEDURE WMCL(fileid:LongWord; dir_dat2db:Boolean); + BEGIN + IF dir_dat2db THEN BEGIN + InsertDatLinkToDB(fileid,$24); + END ELSE BEGIN + END; + END; +PROCEDURE WMMB(fileid:LongWord; dir_dat2db:Boolean); + VAR + i:LongWord; + packages:LongWord; + BEGIN + IF dir_dat2db THEN BEGIN + LoadFilePart($1C,4,@packages); + IF packages>0 THEN + FOR i:=0 TO packages-1 DO InsertDatLinkToDB(fileid,$20+i*4); + END ELSE BEGIN + END; + END; +PROCEDURE WPGE(fileid:LongWord; dir_dat2db:Boolean); + BEGIN + IF dir_dat2db THEN BEGIN + InsertDatLinkToDB(fileid,$08); + InsertDatLinkToDB(fileid,$0C); + END ELSE BEGIN + END; + END; + +PROCEDURE InsertHandler(ext:String; needed:Boolean; handler:THandler); + BEGIN + SetLength(ConvertHandlers,Length(ConvertHandlers)+1); + ConvertHandlers[High(ConvertHandlers)].Ext:=ext; + ConvertHandlers[High(ConvertHandlers)].needed:=needed; + ConvertHandlers[High(ConvertHandlers)].handler:=handler; + END; + +BEGIN + InsertHandler('ABNA',False,NIL); +// InsertHandler('AGDB',True,AGDB); + InsertHandler('AGDB',False,NIL); + InsertHandler('AGQC',False,NIL); + InsertHandler('AGQG',False,NIL); + InsertHandler('AGQR',False,NIL); + InsertHandler('AISA',False,NIL); + InsertHandler('AITR',False,NIL); + InsertHandler('AKAA',False,NIL); + InsertHandler('AKBA',False,NIL); + InsertHandler('AKBP',False,NIL); + InsertHandler('AKDA',False,NIL); + InsertHandler('AKEV',True,AKEV); + InsertHandler('AKOT',True,AKOT); + InsertHandler('AKVA',False,NIL); + InsertHandler('BINA',True,BINA); + InsertHandler('CBPI',True,CBPI); + InsertHandler('CBPM',True,CBPM); + InsertHandler('CONS',True,CONS); + InsertHandler('CRSA',True,CRSA); + InsertHandler('DOOR',True,DOOR); + InsertHandler('DPGE',True,DPGE); + InsertHandler('ENVP',False,NIL); + InsertHandler('FILM',False,NIL); + InsertHandler('HPGE',True,HPGE); + InsertHandler('IDXA',False,NIL); + InsertHandler('IGHH',True,IGHH); + InsertHandler('IGPA',True,IGPA); + InsertHandler('IGPG',True,IGPG); + InsertHandler('IGSA',True,IGSA); + InsertHandler('IMPT',True,IMPT); + InsertHandler('IPGE',True,IPGE); + InsertHandler('KEYI',True,KEYI); + InsertHandler('M3GA',True,M3GA); + InsertHandler('M3GM',True,M3GM); + InsertHandler('MTRL',True,MTRL); + InsertHandler('OBAN',False,NIL); + InsertHandler('OBDC',False,NIL); + InsertHandler('OBOA',True,OBOA); + InsertHandler('OFGA',True,OFGA); + InsertHandler('ONCC',True,ONCC); + InsertHandler('ONCP',False,NIL); + InsertHandler('ONCV',True,ONCV); + InsertHandler('ONFA',False,NIL); + InsertHandler('ONGS',False,NIL); + InsertHandler('ONIA',False,NIL); + InsertHandler('ONLD',False,NIL); + InsertHandler('ONLV',True,ONLV); + InsertHandler('ONMA',False,NIL); + InsertHandler('ONOA',True,ONOA); + InsertHandler('ONSA',False,NIL); + InsertHandler('ONSK',True,ONSK); + InsertHandler('ONTA',False,NIL); + InsertHandler('ONVL',True,ONVL); + InsertHandler('ONWC',True,ONWC); + InsertHandler('OPGE',True,OPGE); + InsertHandler('OSBD',True,OSBD); + InsertHandler('OTIT',False,NIL); + InsertHandler('OTLF',False,NIL); + InsertHandler('PLEA',False,NIL); + InsertHandler('PNTA',False,NIL); + InsertHandler('PSPC',True,PSPC); + InsertHandler('PSPL',True,PSPL); + InsertHandler('PSUI',True,PSUI); + InsertHandler('QTNA',False,NIL); + InsertHandler('SNDD',True,SNDD); + InsertHandler('STNA',True,STNA); + InsertHandler('SUBT',True,SUBT); + InsertHandler('TRAC',True,TRAC); + InsertHandler('TRAM',True,TRAM); + InsertHandler('TRAS',True,TRAS); + InsertHandler('TRBS',True,TRBS); + InsertHandler('TRCM',True,TRCM); + InsertHandler('TRGA',True,TRGA); + InsertHandler('TRGE',True,TRGE); + InsertHandler('TRIA',False,NIL); + InsertHandler('TRIG',True,TRIG); + InsertHandler('TRMA',True,TRMA); + InsertHandler('TRSC',True,TRSC); + InsertHandler('TRTA',False,NIL); + InsertHandler('TSFF',True,TSFF); + InsertHandler('TSFL',False,NIL); + InsertHandler('TSFT',True,TSFT); + InsertHandler('TSGA',False,NIL); + InsertHandler('TSTR',False,NIL); + InsertHandler('TURR',True,TURR); + InsertHandler('TXAN',True,TXAN); + InsertHandler('TXCA',False,NIL); + InsertHandler('TXMA',True,TXMA); + InsertHandler('TXMB',True,TXMB); + InsertHandler('TXMP',True,TXMP); + InsertHandler('TXTC',True,TXTC); + InsertHandler('VCRA',False,NIL); + InsertHandler('WMCL',True,WMCL); + InsertHandler('WMDD',False,NIL); + InsertHandler('WMM_',False,NIL); + InsertHandler('WMMB',True,WMMB); + InsertHandler('WPGE',True,WPGE); +END. Index: /oup/releases/0.21a/Unit11_extractor.dfm =================================================================== --- /oup/releases/0.21a/Unit11_extractor.dfm (revision 21) +++ /oup/releases/0.21a/Unit11_extractor.dfm (revision 21) @@ -0,0 +1,223 @@ +object Form11: TForm11 + Left = 0 + Top = 0 + Width = 495 + Height = 425 + Caption = 'Extractor' + Color = clBtnFace + Font.Charset = DEFAULT_CHARSET + Font.Color = clWindowText + Font.Height = -11 + Font.Name = 'Tahoma' + Font.Style = [] + FormStyle = fsMDIChild + OldCreateOrder = False + Visible = True + WindowState = wsMaximized + OnActivate = FormActivate + OnClose = FormClose + OnCreate = FormCreate + OnResize = FormResize + PixelsPerInch = 96 + TextHeight = 13 + object group_select: TGroupBox + Left = 0 + Top = 0 + Width = 191 + Height = 398 + Align = alClient + Caption = '1. Select file(s)' + TabOrder = 0 + object panel_extension: TPanel + Left = 2 + Top = 371 + Width = 187 + Height = 25 + Align = alBottom + BevelOuter = bvNone + TabOrder = 1 + OnResize = panel_extensionResize + object combo_extension: TComboBox + Left = 2 + Top = 2 + Width = 183 + Height = 21 + Style = csDropDownList + DropDownCount = 12 + Font.Charset = DEFAULT_CHARSET + Font.Color = clWindowText + Font.Height = -11 + Font.Name = 'Tahoma' + Font.Style = [] + ItemHeight = 13 + ParentFont = False + Sorted = True + TabOrder = 0 + OnClick = combo_extensionClick + end + end + object list: TListBox + Left = 2 + Top = 15 + Width = 187 + Height = 356 + Align = alClient + ItemHeight = 13 + MultiSelect = True + TabOrder = 0 + end + end + object group_extract: TGroupBox + Left = 191 + Top = 0 + Width = 296 + Height = 398 + Align = alRight + Caption = '2. Select extract-method' + TabOrder = 1 + object group_singlefiles: TGroupBox + Left = 8 + Top = 16 + Width = 281 + Height = 185 + Caption = 'Write data into single files' + TabOrder = 0 + object btn_sel_dat: TButton + Left = 8 + Top = 16 + Width = 129 + Height = 49 + Caption = 'Selected files (dat contents only)' + TabOrder = 0 + WordWrap = True + OnClick = Extract + end + object btn_sel_datraw: TButton + Left = 8 + Top = 72 + Width = 129 + Height = 49 + Caption = 'Selected files (dat+raw)' + TabOrder = 1 + WordWrap = True + OnClick = Extract + end + object btn_sel_datraw_convert: TButton + Left = 8 + Top = 128 + Width = 129 + Height = 49 + Caption = 'Selected files (dat+raw) (with convert if possible)' + TabOrder = 2 + WordWrap = True + OnClick = Extract + end + object btn_all_dat: TButton + Left = 144 + Top = 16 + Width = 129 + Height = 49 + Caption = 'All files in list (dat contents only)' + TabOrder = 3 + WordWrap = True + OnClick = Extract + end + object btn_all_datraw: TButton + Left = 144 + Top = 72 + Width = 129 + Height = 49 + Caption = 'All files in list (dat+raw)' + TabOrder = 4 + WordWrap = True + OnClick = Extract + end + object btn_all_datraw_convert: TButton + Left = 144 + Top = 128 + Width = 129 + Height = 49 + BiDiMode = bdLeftToRight + Caption = 'All files in list (dat+raw) (with convert if possible)' + ParentBiDiMode = False + TabOrder = 5 + WordWrap = True + OnClick = Extract + end + end + object group_onefile: TGroupBox + Left = 8 + Top = 208 + Width = 281 + Height = 73 + Caption = 'Write data into one file' + TabOrder = 1 + object btn_sel_files_toone: TButton + Left = 8 + Top = 16 + Width = 129 + Height = 49 + Caption = 'Selected files (dat contents only)' + TabOrder = 0 + WordWrap = True + OnClick = Extract + end + object btn_all_files_toone: TButton + Left = 144 + Top = 16 + Width = 129 + Height = 49 + Caption = 'All files in list (dat contents only)' + TabOrder = 1 + WordWrap = True + OnClick = Extract + end + end + object group_progress: TGroupBox + Left = 8 + Top = 288 + Width = 281 + Height = 105 + Caption = 'Progress ...' + TabOrder = 2 + Visible = False + object lbl_progress: TLabel + Left = 8 + Top = 40 + Width = 265 + Height = 17 + AutoSize = False + Caption = 'Files done: 0/0' + end + object lbl_estimated: TLabel + Left = 8 + Top = 56 + Width = 265 + Height = 17 + AutoSize = False + Caption = 'Estimated finishing time: 00:00:00' + end + object progress: TProgressBar + Left = 8 + Top = 16 + Width = 265 + Height = 17 + Smooth = True + TabOrder = 0 + end + object btn_abort: TButton + Left = 8 + Top = 72 + Width = 97 + Height = 23 + Caption = 'Abort' + Enabled = False + TabOrder = 1 + end + end + end + object saved: TSaveDialog + Left = 448 + Top = 328 + end +end Index: /oup/releases/0.21a/Unit11_extractor.pas =================================================================== --- /oup/releases/0.21a/Unit11_extractor.pas (revision 21) +++ /oup/releases/0.21a/Unit11_extractor.pas (revision 21) @@ -0,0 +1,208 @@ +UNIT Unit11_extractor; +INTERFACE +USES + Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, + Dialogs, StdCtrls, ExtCtrls, StrUtils, ComCtrls; +TYPE + TForm11 = Class(TForm) + group_select: TGroupBox; + panel_extension: TPanel; + combo_extension: TComboBox; + list: TListBox; + group_extract: TGroupBox; + group_singlefiles: TGroupBox; + btn_sel_dat: TButton; + btn_sel_datraw: TButton; + btn_sel_datraw_convert: TButton; + btn_all_dat: TButton; + btn_all_datraw: TButton; + btn_all_datraw_convert: TButton; + group_onefile: TGroupBox; + btn_sel_files_toone: TButton; + btn_all_files_toone: TButton; + group_progress: TGroupBox; + progress: TProgressBar; + lbl_progress: TLabel; + lbl_estimated: TLabel; + btn_abort: TButton; + saved: TSaveDialog; + PROCEDURE FormCreate(Sender: TObject); + PROCEDURE FormActivate(Sender: TObject); + PROCEDURE FormClose(Sender: TObject; var Action: TCloseAction); + PROCEDURE FormResize(Sender: TObject); + PROCEDURE combo_extensionClick(Sender: TObject); + PROCEDURE panel_extensionResize(Sender: TObject); + PROCEDURE Extract(Sender: TObject); + PRIVATE + PUBLIC + PROCEDURE Recreatelist; + END; + +VAR + Form11: TForm11; + +IMPLEMENTATION +{$R *.dfm} +USES Unit1_main, Unit2_functions, Unit3_data; + +PROCEDURE TForm11.Recreatelist; + VAR + i:LongWord; + exts:TStringList; + BEGIN + combo_extension.Items.Clear; + combo_extension.Items.Add('_All files_ ('{+IntToStr(dat_header.Files)}+')'); + exts:=GetExtensionsList; + FOR i:=0 TO High(exts) DO + combo_extension.Items.Add(exts[i]); + combo_extension.ItemIndex:=0; + combo_extensionClick(Self); + END; + +PROCEDURE TForm11.panel_extensionResize(Sender: TObject); + BEGIN + combo_extension.Width:=panel_extension.Width-5; + END; + +PROCEDURE TForm11.combo_extensionClick(Sender: TObject); + VAR + Extension:String[4]; + files:TStringList; + i:LongWord; + BEGIN + Extension:=MidStr(combo_extension.Items.Strings[combo_extension.ItemIndex],1,4); + list.Items.Clear; + IF Extension='_All' THEN + files:=GetFilesList('','',True) + ELSE + files:=GetFilesList(extension,'',True); + IF Length(files)>0 THEN + FOR i:=0 TO High(files) DO + list.Items.Add(files[i]); + END; + +PROCEDURE TForm11.FormResize(Sender: TObject); + BEGIN + IF Self.Width>=450 THEN BEGIN + END ELSE Self.Width:=450; + IF Self.Height>=400 THEN BEGIN + group_progress.Height:=group_extract.Height-293; + END ELSE Self.Height:=400; + END; + +PROCEDURE TForm11.FormClose(Sender: TObject; var Action: TCloseAction); + BEGIN + Action:=caFree; + Form1.close_window(Self.Name); + END; + +PROCEDURE TForm11.FormActivate(Sender: TObject); + BEGIN + Form1.SetActiveWindow(Self.Name); + END; + +PROCEDURE TForm11.FormCreate(Sender: TObject); + BEGIN + btn_sel_dat.Caption:= 'Selected files'+CrLf+'(dat contents only)'; + btn_sel_datraw.Caption:= 'Selected files'+CrLf+'(dat+raw contents)'; + btn_sel_datraw_convert.Caption:='Selected files'+CrLf+'(dat+raw contents)'+CrLf+'(with convert if possible)'; + btn_all_dat.Caption:= 'All files in list'+CrLf+'(dat contents only)'; + btn_all_datraw.Caption:= 'All files in list'+CrLf+'(dat+raw contents)'; + btn_all_datraw_convert.Caption:='All files in list'+CrLf+'(dat+raw contents)'+CrLf+'(with convert if possible)'; + btn_sel_files_toone.Caption:= 'Selected files'+CrLf+'(dat contents only)'; + btn_all_files_toone.Caption:= 'All files in list'+CrLf+'(dat contents only)'; + END; + +PROCEDURE TForm11.Extract(Sender: TObject); + VAR + sel_only:Boolean; + dat_only:Boolean; + convert:Boolean; + one_file:Boolean; + settings:TExportSet; + files:LongWord; + i,done:LongWord; + begintime:Double; + BEGIN + sel_only:=Pos('sel',TButton(Sender).Name)>0; + dat_only:=NOT (Pos('datraw',TButton(Sender).Name)>0); + convert:=Pos('convert',TButton(Sender).Name)>0; + one_file:=Pos('toone',TButton(Sender).Name)>0; + IF dat_only THEN settings:=[DO_dat] + ELSE settings:=[DO_dat,DO_raw]; + IF convert THEN settings:=settings+[DO_convert]; + IF one_file THEN settings:=settings+[DO_toone]; + progress.Position:=0; + + IF saved.Execute THEN BEGIN + begintime:=Time; + group_progress.Visible:=True; + group_select.Enabled:=False; + group_singlefiles.Enabled:=False; + group_onefile.Enabled:=False; + lbl_estimated.Caption:='Estimated finishing time: unknown'; + IF one_file THEN BEGIN + IF FileExists(saved.FileName) THEN BEGIN + IF MessageBox(Self.Handle,PChar('File already exists. Do you want to overwrite it?'),PChar('Warning!'),MB_YESNO)=ID_YES THEN BEGIN + DeleteFile(saved.FileName); + END ELSE BEGIN + group_progress.Visible:=False; + group_select.Enabled:=True; + group_singlefiles.Enabled:=True; + group_onefile.Enabled:=True; + Exit; + END; + END; + i:=FileCreate(saved.FileName); + FileClose(i); + i:=0; + END; + IF sel_only THEN BEGIN + files:=list.SelCount; + lbl_progress.Caption:='Files done: 0/'+IntToStr(files); + progress.Max:=files; + done:=0; + FOR i:=0 TO list.Count-1 DO BEGIN + IF list.Selected[i] THEN BEGIN + IF one_file THEN BEGIN + ExportFile(StrToInt(MidStr(list.Items.Strings[i],1,5)),ExtractFileName(saved.FileName),settings,ExtractFileDir(saved.FileName)); + END ELSE BEGIN + ExportFile(StrToInt(MidStr(list.Items.Strings[i],1,5)),list.Items.Strings[i],settings,'D:'); + END; + Inc(done); + END; + IF ((done MOD 10)=0) AND (done>=50) THEN + lbl_estimated.Caption:='Estimated finishing time: '+TimeToStr((Time-begintime)/done*files+begintime); + IF (i MOD 10)=0 THEN BEGIN + progress.Position:=done; + lbl_progress.Caption:='Files done: '+IntToStr(done)+'/'+IntToStr(files); + Application.ProcessMessages; + END; + END; + END ELSE BEGIN + files:=list.Count; + lbl_progress.Caption:='Files done: 0/'+IntToStr(files); + progress.Max:=files; + FOR i:=0 TO list.Count-1 DO BEGIN + IF one_file THEN BEGIN + ExportFile(StrToInt(MidStr(list.Items.Strings[i],1,5)),ExtractFileName(saved.FileName),settings,ExtractFileDir(saved.FileName)); + END ELSE BEGIN + ExportFile(StrToInt(MidStr(list.Items.Strings[i],1,5)),list.Items.Strings[i],settings,'D:'); + END; + IF ((i MOD 10)=0) AND (i>=50) THEN + lbl_estimated.Caption:='Estimated finishing time: '+TimeToStr((Time-begintime)/i*files+begintime); + IF (i MOD 5)=0 THEN BEGIN + progress.Position:=i; + lbl_progress.Caption:='Files done: '+IntToStr(i)+'/'+IntToStr(files); + Application.ProcessMessages; + END; + END; + END; + group_progress.Visible:=False; + group_select.Enabled:=True; + group_singlefiles.Enabled:=True; + group_onefile.Enabled:=True; + END; + END; + +END. Index: /oup/releases/0.21a/Unit12_ValueEdit.dfm =================================================================== --- /oup/releases/0.21a/Unit12_ValueEdit.dfm (revision 21) +++ /oup/releases/0.21a/Unit12_ValueEdit.dfm (revision 21) @@ -0,0 +1,17 @@ +object Form12: TForm12 + Left = 0 + Top = 0 + BorderStyle = bsToolWindow + Caption = 'Value Edit' + ClientHeight = 298 + ClientWidth = 428 + Color = clBtnFace + Font.Charset = DEFAULT_CHARSET + Font.Color = clWindowText + Font.Height = -11 + Font.Name = 'Tahoma' + Font.Style = [] + OldCreateOrder = False + PixelsPerInch = 96 + TextHeight = 13 +end Index: /oup/releases/0.21a/Unit12_ValueEdit.pas =================================================================== --- /oup/releases/0.21a/Unit12_ValueEdit.pas (revision 21) +++ /oup/releases/0.21a/Unit12_ValueEdit.pas (revision 21) @@ -0,0 +1,24 @@ +unit Unit12_ValueEdit; + +interface + +uses + Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, + Dialogs; + +type + TForm12 = class(TForm) + private + { Private declarations } + public + { Public declarations } + end; + +var + Form12: TForm12; + +implementation + +{$R *.dfm} + +end. Index: /oup/releases/0.21a/Unit1_main.dfm =================================================================== --- /oup/releases/0.21a/Unit1_main.dfm (revision 21) +++ /oup/releases/0.21a/Unit1_main.dfm (revision 21) @@ -0,0 +1,167 @@ +object Form1: TForm1 + Left = 0 + Top = 0 + HorzScrollBar.Visible = False + VertScrollBar.Visible = False + AutoScroll = False + Caption = 'Form1' + ClientHeight = 544 + ClientWidth = 692 + Color = clBtnFace + Font.Charset = DEFAULT_CHARSET + Font.Color = clWindowText + Font.Height = -11 + Font.Name = 'Tahoma' + Font.Style = [] + FormStyle = fsMDIForm + Menu = menu + OldCreateOrder = False + OnClose = FormClose + OnCreate = FormCreate + OnResize = FormResize + PixelsPerInch = 96 + TextHeight = 13 + object statbar: TStatusBar + Left = 0 + Top = 527 + Width = 692 + Height = 17 + BiDiMode = bdLeftToRight + Panels = < + item + Text = 'Nothing loaded' + Width = 500 + end + item + Text = 'Files: -' + Width = 90 + end + item + Text = 'Extensions: -' + Width = 100 + end> + ParentBiDiMode = False + end + object tabs: TTabSet + Left = 0 + Top = 507 + Width = 692 + Height = 20 + Align = alBottom + DitherBackground = False + Font.Charset = DEFAULT_CHARSET + Font.Color = clWindowText + Font.Height = -11 + Font.Name = 'Tahoma' + Font.Style = [] + SoftTop = True + Style = tsModernTabs + OnChange = tabsChange + end + object opend: TOpenDialog + Options = [ofPathMustExist, ofFileMustExist, ofEnableSizing] + Left = 480 + end + object menu: TMainMenu + AutoHotkeys = maManual + Left = 592 + object menu_main: TMenuItem + Caption = '&Main' + object menu_loaddat: TMenuItem + Caption = '&Select .dat-file ...' + ShortCut = 16463 + OnClick = menu_loaddatClick + end + object menu_lvldb: TMenuItem + Caption = 'Open OUP-Level-&DB ...' + ShortCut = 16452 + OnClick = menu_lvldbClick + end + object menu_sep1: TMenuItem + Caption = '-' + end + object menu_exit: TMenuItem + Caption = '&Exit' + OnClick = menu_exitClick + end + end + object menu_convert: TMenuItem + Caption = '&Convert' + Enabled = False + object menu_createdb: TMenuItem + Caption = 'Create level-database' + Enabled = False + OnClick = menu_createdbClick + end + object menu_createlvl: TMenuItem + Caption = 'Create level-files' + Enabled = False + OnClick = menu_createlvlClick + end + end + object menu_tools: TMenuItem + Caption = '&Tools' + Enabled = False + object menu_preview: TMenuItem + Caption = '&Preview Window ...' + ShortCut = 16464 + OnClick = menu_previewClick + end + object menu_binedit: TMenuItem + Caption = '&Binary .dat editor ...' + ShortCut = 16450 + OnClick = menu_bineditClick + end + object menu_txmpreplace: TMenuItem + Caption = '&TXMP replacer ...' + ShortCut = 16468 + OnClick = menu_txmpreplaceClick + end + object menu_extractor: TMenuItem + Caption = 'File &extractor ...' + ShortCut = 16453 + OnClick = menu_extractorClick + end + object menu_levelstructedit: TMenuItem + Caption = 'Levelfile structure editor ...' + Enabled = False + ShortCut = 16460 + end + end + object menu_windows: TMenuItem + Caption = '&Windows' + object menu_windows_cascade: TMenuItem + Caption = 'Cascade' + OnClick = menu_windows_cascadeClick + end + object menu_windows_tile: TMenuItem + Caption = 'Tile' + OnClick = menu_windows_tileClick + end + object menu_windows_closeall: TMenuItem + Caption = '&Close all' + OnClick = menu_windows_closeallClick + end + object menu_sep3: TMenuItem + Caption = '-' + end + object menu_windows_next: TMenuItem + Caption = 'Next window' + ShortCut = 16417 + OnClick = menu_windows_nextClick + end + object menu_windows_previous: TMenuItem + Caption = 'Previous window' + ShortCut = 16418 + OnClick = menu_windows_previousClick + end + object menu_sep2: TMenuItem + Caption = '-' + end + end + end + object saved: TSaveDialog + Options = [ofOverwritePrompt, ofPathMustExist, ofEnableSizing] + Left = 520 + end +end Index: /oup/releases/0.21a/Unit1_main.pas =================================================================== --- /oup/releases/0.21a/Unit1_main.pas (revision 21) +++ /oup/releases/0.21a/Unit1_main.pas (revision 21) @@ -0,0 +1,434 @@ +UNIT Unit1_main; +INTERFACE +USES + Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, + Dialogs, StdCtrls, StrUtils, Clipbrd, ExtCtrls, ComCtrls, Menus, Grids, + MPHexEditor, ToolWin, ImgList, Tabs, + Unit2_functions, Unit3_data, + Unit10_leveldb, +Unit4_exporters, + Unit5_preview, Unit7_txmpreplace, Unit8_binedit, Unit11_extractor; + +TYPE + TForm1 = Class(TForm) + tabs: TTabSet; + saved: TSaveDialog; + opend: TOpenDialog; + statbar: TStatusBar; + menu: TMainMenu; + menu_main: TMenuItem; + menu_loaddat: TMenuItem; + menu_lvldb: TMenuItem; + menu_exit: TMenuItem; + menu_convert: TMenuItem; + menu_createdb: TMenuItem; + menu_createlvl: TMenuItem; + menu_tools: TMenuItem; + menu_preview: TMenuItem; + menu_txmpreplace: TMenuItem; + menu_binedit: TMenuItem; + menu_extractor: TMenuItem; + menu_windows: TMenuItem; + menu_windows_cascade: TMenuItem; + menu_windows_tile: TMenuItem; + menu_windows_closeall: TMenuItem; + menu_windows_next: TMenuItem; + menu_windows_previous: TMenuItem; + menu_sep1: TMenuItem; + menu_sep2: TMenuItem; + menu_sep3: TMenuItem; + menu_levelstructedit: TMenuItem; + PROCEDURE menu_createlvlClick(Sender: TObject); + PROCEDURE menu_extractorClick(Sender: TObject); + PROCEDURE menu_lvldbClick(Sender: TObject); + PROCEDURE menu_createdbClick(Sender: TObject); + PROCEDURE SetActiveWindow(window_name:String); + PROCEDURE tabsChange(Sender: TObject; NewTab: Integer; var AllowChange: Boolean); + PROCEDURE close_window(window_name:String); + PROCEDURE menu_windows_previousClick(Sender: TObject); + PROCEDURE menu_windows_nextClick(Sender: TObject); + PROCEDURE menu_windows_tileClick(Sender: TObject); + PROCEDURE open_child(window_context:String); + PROCEDURE menu_windows_closeallClick(Sender: TObject); + PROCEDURE menu_windows_cascadeClick(Sender: TObject); + PROCEDURE menu_window_entryClick(Sender: TObject); + PROCEDURE menu_bineditClick(Sender: TObject); + PROCEDURE menu_loaddatClick(Sender: TObject); + PROCEDURE menu_txmpreplaceClick(Sender: TObject); + PROCEDURE menu_exitClick(Sender: TObject); + PROCEDURE menu_previewClick(Sender: TObject); + PROCEDURE FormClose(Sender: TObject; var Action: TCloseAction); + PROCEDURE FormResize(Sender: TObject); + PROCEDURE FormCreate(Sender: TObject); + PRIVATE + PUBLIC + END; + +VAR + Form1: TForm1; + +IMPLEMENTATION +{$R *.dfm} +VAR + tablist:Array OF String; + +PROCEDURE TForm1.FormCreate(Sender: TObject); + BEGIN + Form1.Caption:='Oni Un/Packer '+version; + Form1.FormResize(Form1); + + IF FileExists(ExtractFilepath(Application.EXEname)+'\oniunpacker.ini') THEN BEGIN + AssignFile(AppSettingsFile,ExtractFilepath(Application.EXEname)+'\oniunpacker.ini'); + Reset(AppSettingsFile); + Read(AppSettingsFile,AppSettings); + CloseFile(AppSettingsFile); + END ELSE BEGIN + AppSettings.DatPath:='D:\Spiele\Oni\GameDataFolder'; + AppSettings.ExtractPath:='C:\Dokumente und Einstellungen\Administrator\Desktop'; + END; + END; + +PROCEDURE TForm1.FormResize(Sender: TObject); + CONST + MinWidth:Integer=750; + MinHeight:Integer=500; + BEGIN + IF Form1.Width0 THEN BEGIN + FOR i:=0 TO MDIChildCount-1 DO BEGIN + MDIChildren[i].Close; + END; + END; + tabs.Tabs.Clear; + END; +PROCEDURE TForm1.menu_windows_nextClick(Sender: TObject); + VAR i:Byte; + first_window:Byte; + current_focus:String; + BEGIN + IF MDIChildCount>1 THEN BEGIN + FOR i:=0 TO menu_windows.Count-1 DO BEGIN + IF Pos('menu_window_',menu_windows.Items[i].Name)=1 THEN BEGIN + first_window:=i; + Break; + END; + END; + current_focus:=ActiveMDIChild.Name; + FOR i:=first_window TO menu_windows.Count-1 DO + IF Pos(current_focus,menu_windows.Items[i].Name)>0 THEN + Break; + IF i=menu_windows.Count-1 THEN + menu_windows.Items[first_window].Click + ELSE + menu_windows.Items[i+1].Click; + FOR i:=0 TO High(tablist) DO BEGIN + IF tablist[i]=ActiveMDIChild.Name THEN BEGIN + tabs.TabIndex:=i; + END; + END; + END; + END; +PROCEDURE TForm1.menu_windows_previousClick(Sender: TObject); + VAR i:Byte; + first_window:Byte; + current_focus:String; + BEGIN + IF MDIChildCount>1 THEN BEGIN + FOR i:=0 TO menu_windows.Count-1 DO BEGIN + IF Pos('menu_window_',menu_windows.Items[i].Name)=1 THEN BEGIN + first_window:=i; + Break; + END; + END; + current_focus:=ActiveMDIChild.Name; + FOR i:=first_window TO menu_windows.Count-1 DO + IF Pos(current_focus,menu_windows.Items[i].Name)>0 THEN + Break; + IF i=first_window THEN + menu_windows.Items[menu_windows.Count-1].Click + ELSE + menu_windows.Items[i-1].Click; + FOR i:=0 TO High(tablist) DO BEGIN + IF tablist[i]=ActiveMDIChild.Name THEN BEGIN + tabs.TabIndex:=i; + END; + END; + END; + END; + +PROCEDURE TForm1.menu_window_entryClick(Sender: TObject); + VAR + i:Byte; + window_name:String; + BEGIN + window_name:=MidStr(TComponent(Sender).Name,Pos('window_',TComponent(Sender).Name)+7,Length(TComponent(Sender).Name)-Pos('window_',TComponent(Sender).Name)+7+1); + FOR i:=0 TO MDIChildCount-1 DO BEGIN + IF MDIChildren[i].Name=window_name THEN BEGIN + MDIChildren[i].BringToFront; + END; + END; + FOR i:=0 TO High(tablist) DO BEGIN + IF tablist[i]=ActiveMDIChild.Name THEN BEGIN + tabs.TabIndex:=i; + END; + END; + END; + + + +PROCEDURE TForm1.open_child(window_context:String); + VAR + binEdit:TForm8; + preview:TForm5; + txmpreplacer:TForm7; + extractor:TForm11; + menu_button:TMenuItem; + used:Array[1..9] OF Boolean; + i:Byte; + caption:String; + name:String; + BEGIN + FOR i:=1 TO 9 DO used[i]:=False; + IF MDIChildCount>0 THEN + FOR i:=0 TO MDIChildCount-1 DO + IF Pos(window_context,Form1.MDIChildren[i].Name)=1 THEN + used[StrToInt(RightStr(Form1.MDIChildren[i].Caption,1))]:=True; + FOR i:=1 TO 10 DO + IF i=10 THEN + Break + ELSE + IF NOT used[i] THEN Break; + + IF i<10 THEN BEGIN + name:=window_context+IntToStr(i); + IF window_context='binedit' THEN + caption:='Binary .dat-Editor '+IntToStr(i); + IF window_context='preview' THEN + caption:='Preview-Window '+IntToStr(i); + IF window_context='txmpreplace' THEN + caption:='TXMP Replacer '+IntToStr(i); + IF window_context='extractor' THEN + caption:='Extractor '+IntToStr(i); + + menu_button:=TMenuItem.Create(menu_windows); + menu_button.Caption:=caption; + menu_button.Name:='menu_window_'+name; + menu_button.OnClick:=Form1.menu_window_entryClick; + menu_windows.Add(menu_button); + + SetLength(tablist,Length(tablist)+1); + tablist[High(tablist)]:=name; + tabs.Tabs.Add(caption); + + IF window_context='binedit' THEN BEGIN + binEdit:=TForm8.Create(Application); + binEdit.Name:=name; + binEdit.Caption:=caption; + binEdit.Recreatelist; + END; + IF window_context='preview' THEN BEGIN + preview:=TForm5.Create(Application); + preview.Name:=name; + preview.Caption:=caption; + preview.Recreatelist; + END; + IF window_context='txmpreplace' THEN BEGIN + txmpreplacer:=TForm7.Create(Application); + txmpreplacer.Name:=name; + txmpreplacer.Caption:=caption; + txmpreplacer.Recreatelist; + END; + IF window_context='extractor' THEN BEGIN + extractor:=TForm11.Create(Application); + extractor.Name:=name; + extractor.Caption:=caption; + extractor.Recreatelist; + END; + + tabs.TabIndex:=High(tablist); + IF MDIChildCount=9 THEN menu_tools.Enabled:=False; + END; + END; + + +PROCEDURE TForm1.close_window(window_name:String); + VAR + i,j:Byte; + BEGIN + FOR i:=0 TO menu_windows.Count-1 DO BEGIN + IF menu_windows.Items[i].Name='menu_window_'+window_name THEN BEGIN + menu_windows.Items[i].Free; + Break; + END; + END; + FOR i:=0 TO High(tablist) DO BEGIN + IF tablist[i]=window_name THEN BEGIN + tabs.Tabs.Delete(i); + IF High(tablist)>0 THEN + FOR j:=i TO High(tablist)-1 DO + tablist[j]:=tablist[j+1]; + SetLength(tablist,Length(tablist)-1); + Break; + END; + END; + menu_tools.Enabled:=True; + END; + + +PROCEDURE TForm1.tabsChange(Sender: TObject; NewTab: Integer; var AllowChange: Boolean); + VAR + i:Byte; + BEGIN + FOR i:=0 TO MDIChildCount-1 DO BEGIN + IF MDIChildren[i].Name=tablist[NewTab] THEN + MDIChildren[i].BringToFront; + END; + END; + +PROCEDURE TForm1.SetActiveWindow(window_name:String); + VAR + i:Byte; + BEGIN + IF Length(tablist)>0 THEN + FOR i:=0 TO High(tablist) DO + IF tablist[i]=window_name THEN + tabs.TabIndex:=i; + END; + + +END. Index: /oup/releases/0.21a/Unit2_functions.pas =================================================================== --- /oup/releases/0.21a/Unit2_functions.pas (revision 21) +++ /oup/releases/0.21a/Unit2_functions.pas (revision 21) @@ -0,0 +1,456 @@ +UNIT Unit2_functions; +INTERFACE +USES Classes, Dialogs, SysUtils, StrUtils, Math, SQLiteTable3, + Unit3_data, Unit4_Exporters; + +TYPE + TExportSet=SET OF (DO_dat,DO_raw,DO_convert,DO_toone); + +FUNCTION GetFilesList(ext:String; pattern:String; NoEmptyFiles:Boolean):TStringList; +FUNCTION GetExtensionsList:TStringList; + +FUNCTION Decode_Int(buffer:Tdata):LongWord; +FUNCTION Encode_Int(input:LongWord):Tdata; +FUNCTION Decode_Float(buffer:Tdata):Single; +FUNCTION Encode_Float(input:Single):Tdata; + +FUNCTION LoadDatInfos(filename:String):Boolean; +PROCEDURE OpenDatabase(FileName:String); + +FUNCTION LoadDatFile(fileid:LongWord):Tdata; +PROCEDURE UpdateDatFile(fileid:LongWord; data:Tdata); +FUNCTION LoadDatFilePart(fileid,offset,size:LongWord; target:Pointer):Boolean; +FUNCTION UpdateDatFilePart(fileid,offset,size:LongWord; target:Pointer):Boolean; + +FUNCTION LoadRawFile(fileid,datlinkoffset,size:LongWord; target:Pointer):Boolean; +FUNCTION UpdateRawFile(fileid,datlinkoffset,size:LongWord; target:Pointer):Boolean; + +FUNCTION ExportFile(fileid:LongWord; filename:String; settings:TExportSet; path:String):Integer; + +FUNCTION FormatNumber(value:LongWord; width:Byte; leadingzeros:Char):String; +FUNCTION FormatFileSize(size:LongWord):String; +FUNCTION CreateHexString(data:Tdata; HexOnly:Boolean):String; +FUNCTION GetWinFileName(name:String):String; +FUNCTION GetExtractPath:String; + + +IMPLEMENTATION + +TYPE + TValueSwitcher=Record + CASE IsFloat: Boolean OF + True: (ValueFloat:Single); + False: (ValueInt:LongWord); + END; + +FUNCTION Decode_Int(buffer:Tdata):LongWord; + BEGIN + Result:=buffer[0]+buffer[1]*256+buffer[2]*256*256+buffer[3]*256*256*256; + END; +FUNCTION Encode_Int(input:LongWord):Tdata; + BEGIN + Result[0]:=input MOD 256; + input:=input DIV 256; + Result[1]:=input MOD 256; + input:=input DIV 256; + Result[2]:=input MOD 256; + input:=input DIV 256; + Result[3]:=input MOD 256; + END; +FUNCTION Decode_Float(buffer:Tdata):Single; + VAR _valueswitcher:TValueSwitcher; + BEGIN + _valueswitcher.ValueInt:=Decode_Int(buffer); + Result:=_valueswitcher.ValueFloat; + END; +FUNCTION Encode_Float(input:Single):Tdata; + VAR _valueswitcher:TValueSwitcher; + BEGIN + _valueswitcher.ValueFloat:=input; + Result:=Encode_Int(_valueswitcher.ValueInt); + END; + + +FUNCTION GetFilesList(ext:String; pattern:String; NoEmptyFiles:Boolean):TStringList; + VAR + i:LongWord; + where:String; + Tbl:TSQLiteTable; + BEGIN + SetLength(Result,0); + IF opened_state=opened_dat THEN BEGIN + FOR i:=0 TO dat_header.Files-1 DO BEGIN + IF ( (Length(ext)=0) OR (dat_files[i].Extension=ext) ) AND + ( (Length(pattern)=0) OR (Pos(pattern,dat_files[i].Name)>0) ) THEN BEGIN + IF NoEmptyFiles THEN BEGIN + IF (dat_files[i].FileType AND $02)=0 THEN BEGIN + SetLength(Result,Length(Result)+1); + Result[High(Result)]:=dat_files[i].FileName; + END; + END ELSE BEGIN + SetLength(Result,Length(Result)+1); + Result[High(Result)]:=dat_files[i].FileName; + END; + END; + END; + END ELSE BEGIN + where:=''; + IF Length(ext)>0 THEN BEGIN + IF Length(where)>0 THEN where:=where+' AND '; + where:=where+'(extension="'+ext+'")'; + END; + IF Length(pattern)>0 THEN BEGIN + IF Length(where)>0 THEN where:=where+' AND '; + where:=where+'(name LIKE "%'+pattern+'%")'; + END; + IF NoEmptyFiles THEN BEGIN + IF Length(where)>0 THEN where:=where+' AND '; + where:=where+'((contenttype & 2)=0)'; + END; + IF Length(where)>0 THEN where:=' WHERE '+where; + Tbl:=DB.GetTable('SELECT id,name,extension FROM datfiles'+where+' ORDER BY id ASC;'); + IF Tbl.Count>0 THEN BEGIN + SetLength(Result,Tbl.Count); + i:=0; + REPEAT + Result[i]:=FormatNumber(Tbl.FieldAsInteger('id'),5,'0')+'-'+Tbl.FieldAsString('name')+'.'+Tbl.FieldAsString('extension'); + Inc(i); + Tbl.Next; + UNTIL Tbl.EOF; + END; + END; + END; + +FUNCTION GetExtensionsList:TStringList; + VAR + i:LongWord; + Tbl:TSQLiteTable; + BEGIN + SetLength(Result,0); + IF opened_state=opened_dat THEN BEGIN + FOR i:=0 TO dat_header.Extensions-1 DO BEGIN + SetLength(Result,Length(Result)+1); + WITH dat_extensionsmap[i] DO BEGIN + Result[High(Result)]:=Extension[3]+Extension[2]+Extension[1]+Extension[0]+' ('+IntToStr(ExtCount)+')'; + END; + END; + END ELSE BEGIN + Tbl:=DB.GetTable('SELECT extension,count(extension) AS x FROM datfiles GROUP BY extension ORDER BY extension ASC;'); + IF Tbl.Count>0 THEN BEGIN + SetLength(Result,Tbl.Count); + i:=0; + REPEAT + Result[i]:=Tbl.FieldAsString('extension')+' ('+IntToStr(Tbl.FieldAsInteger('x'))+')'; + Inc(i); + Tbl.Next; + UNTIL Tbl.EOF; + END; + END; + END; + +FUNCTION LoadDatInfos(filename:String):Boolean; + VAR i:LongWord; + dat_file:TFileStream; + BEGIN + Result:=True; + opened_state:=opened_dat; + dat_filename:=filename; + raw_filename:=MidStr(filename,1,Length(filename)-3)+'raw'; + dat_file:=TFileStream.Create(filename, fmOpenRead); + dat_file.Read(dat_header,SizeOf(dat_header)); + FOR i:=0 TO High(dat_header.Ident) DO + IF dat_header.Ident[i]<>header_ident1[i] THEN BEGIN + Result:=False; + Exit; + END; + SetLength(dat_filesmap,dat_header.Files); + SetLength(dat_files,dat_header.Files); + FOR i:=0 TO dat_header.Files-1 DO dat_file.Read(dat_filesmap[i],SizeOf(dat_filesmap[i])); + FOR i:=0 TO dat_header.Files-1 DO BEGIN + dat_files[i].Extension:=dat_filesmap[i].Extension; + dat_files[i].Extension:=ReverseString(dat_files[i].Extension); + dat_files[i].Size:=dat_filesmap[i].FileSize; + dat_files[i].FileType:=dat_filesmap[i].FileType; + dat_files[i].DatAddr:=dat_filesmap[i].DataAddr-8+dat_header.DataAddr; + IF (dat_filesmap[i].FileType AND $01)=0 THEN BEGIN + dat_file.Seek(dat_filesmap[i].NameAddr+dat_header.NamesAddr,soFromBeginning); + SetLength(dat_files[i].Name,100); + dat_file.Read(dat_files[i].Name[1],100); + dat_files[i].Name:=MidStr(dat_files[i].Name,1+4,Pos(#0,dat_files[i].Name)-1-4); + END ELSE BEGIN + dat_files[i].Name:=''; + END; + dat_files[i].FileName:=FormatNumber(i,5,'0')+'-'+dat_files[i].Name+'.'+dat_files[i].Extension; + END; + dat_file.Seek($40+dat_header.Files*$14,soFromBeginning); + SetLength(dat_namedfilesmap,dat_header.NamedFiles); + FOR i:=0 TO dat_header.NamedFiles-1 DO dat_file.Read(dat_namedfilesmap[i],SizeOf(dat_namedfilesmap[i])); + + dat_file.Seek($40+dat_header.Files*$14+dat_header.NamedFiles*$8,soFromBeginning); + SetLength(dat_extensionsmap,dat_header.Extensions); + FOR i:=0 TO dat_header.Extensions-1 DO dat_file.Read(dat_extensionsmap[i],SizeOf(dat_extensionsmap[i])); + + dat_file.Free; + END; + + +FUNCTION LoadDatFile(fileid:LongWord):Tdata; + VAR + dat_file:TFileStream; + Tbl:TSQLiteTable; + mem:TMemoryStream; + BEGIN + IF opened_state=opened_dat THEN BEGIN + dat_file:=TFileStream.Create(dat_filename, fmOpenRead); + dat_file.Seek(dat_files[fileid].DatAddr,soFromBeginning); + SetLength(Result,dat_files[fileid].Size); + dat_file.Read(Result[0],dat_files[fileid].Size); + dat_file.Free; + END ELSE BEGIN + Tbl:=DB.GetTable('SELECT data FROM datfiles WHERE id='+IntToStr(fileid)+';'); + IF Tbl.Count>0 THEN BEGIN + mem:=Tbl.FieldAsBlob('data'); + SetLength(Result,mem.Size); + mem.Seek(0,soFromBeginning); + mem.Read(Result[0],mem.Size); + mem.Free; + END; + END; + END; +PROCEDURE UpdateDatFile(fileid:LongWord; data:Tdata); + VAR + dat_file:TFileStream; + Tbl:TSQLiteTable; + BEGIN + IF opened_state=opened_dat THEN BEGIN + dat_file:=TFileStream.Create(dat_filename, fmOpenReadWrite); + dat_file.Seek(dat_files[fileid].DatAddr,soFromBeginning); + dat_file.Write(data[0],Length(data)); + dat_file.Free; + END ELSE BEGIN + END; + END; + +FUNCTION LoadDatFilePart(fileid,offset,size:LongWord; target:Pointer):Boolean; + VAR + dat_file:TFileStream; + Tbl:TSQLiteTable; + mem:TMemoryStream; + BEGIN + IF opened_state=opened_dat THEN BEGIN + dat_file:=TFileStream.Create(dat_filename, fmOpenRead); + Result:=True; + dat_file.Seek(dat_files[fileid].DatAddr+offset,soFromBeginning); + dat_file.Read(target^,size); + dat_file.Free; + END ELSE BEGIN + Tbl:=DB.GetTable('SELECT data FROM datfiles WHERE id='+IntToStr(fileid)+';'); + IF Tbl.Count>0 THEN BEGIN + Result:=True; + mem:=Tbl.FieldAsBlob('data'); + mem.Seek(offset,soFromBeginning); + mem.Read(target^,size); + mem.Free; + END; + END; + END; +FUNCTION UpdateDatFilePart(fileid,offset,size:LongWord; target:Pointer):Boolean; + VAR + dat_file:TFileStream; + Tbl:TSQLiteTable; + BEGIN + IF opened_state=opened_dat THEN BEGIN + dat_file:=TFileStream.Create(dat_filename, fmOpenReadWrite); + Result:=True; + dat_file.Seek(dat_files[fileid].DatAddr+offset,soFromBeginning); + dat_file.Write(target^,size); + dat_file.Free; + END ELSE BEGIN + END; + END; + +FUNCTION LoadRawFile(fileid,datlinkoffset,size:LongWord; target:Pointer):Boolean; + VAR + filestream:TFileStream; + raw_addr:LongWord; + Tbl:TSQLiteTable; + mem:TMemoryStream; + BEGIN + IF opened_state=opened_dat THEN BEGIN + Result:=True; + LoadDatFilePart(fileid,datlinkoffset,4,@raw_addr); + filestream:=TFileStream.Create(AnsiReplaceStr(dat_filename,'.dat','.raw'),fmOpenRead); + filestream.Seek(raw_addr,soFromBeginning); + filestream.Read(target^,size); + filestream.Free; + END ELSE BEGIN + Tbl:=DB.GetTable('SELECT data FROM rawmap WHERE (src_id='+IntToStr(fileid)+') AND (src_link_offset='+IntToStr(datlinkoffset)+');'); + IF Tbl.Count>0 THEN BEGIN + Result:=True; + mem:=Tbl.FieldAsBlob('data'); + mem.Seek(0,soFromBeginning); + mem.Read(target^,size); + mem.Free; + END; + END; + END; +FUNCTION UpdateRawFile(fileid,datlinkoffset,size:LongWord; target:Pointer):Boolean; + VAR + filestream:TFileStream; + raw_addr:LongWord; + BEGIN + IF opened_state=opened_dat THEN BEGIN + Result:=True; + LoadDatFilePart(fileid,datlinkoffset,4,@raw_addr); + filestream:=TFileStream.Create(AnsiReplaceStr(dat_filename,'.dat','.raw'),fmOpenReadWrite); + filestream.Seek(raw_addr,soFromBeginning); + filestream.Write(target^,size); + filestream.Free; + END ELSE BEGIN + END; + END; + + +FUNCTION FormatNumber(value:LongWord; width:Byte; leadingzeros:Char):String; + BEGIN + Result:=AnsiReplaceStr(Format('%'+IntToStr(width)+'u',[value]),' ',leadingzeros); + END; + +FUNCTION FormatFileSize(size:LongWord):String; + BEGIN + IF size>=1000*1024*1024 THEN BEGIN + Result:=FloatToStrF(size/1024/1024/1024,ffFixed,5,1)+' GB'; + END ELSE BEGIN + IF size>=1000*1024 THEN BEGIN + Result:=FloatToStrF(size/1024/1024,ffFixed,5,1)+' MB'; + END ELSE BEGIN + IF size>=1000 THEN BEGIN + Result:=FloatToStrF(size/1024,ffFixed,5,1)+' KB'; + END ELSE BEGIN + Result:=IntToStr(size)+' B'; + END; + END; + END; + END; + +FUNCTION CreateHexString(data:Tdata; HexOnly:Boolean):String; + VAR + string_build,ascii_version:String; + i:LongWord; + BEGIN + string_build:=''; + ascii_version:=''; + FOR i:=0 TO High(data) DO BEGIN + IF NOT HexOnly THEN + IF (i MOD 16)=0 THEN + string_build:=string_build+'0x'+IntToHex(i,6)+' '; + string_build:=string_build+IntToHex(data[i],2); + IF NOT HexOnly THEN BEGIN + IF data[i]>=32 THEN ascii_version:=ascii_version+Chr(data[i]) + ELSE ascii_version:=ascii_version+'.'; + IF ((i+1) MOD 2)=0 THEN string_build:=string_build+#32; + IF ((i+1) MOD 16)=0 THEN BEGIN + string_build:=string_build+#32+ascii_version+CrLf; + ascii_version:=''; + END; + END; + END; + Result:=string_build; + END; + + +FUNCTION ExportFile(fileid:LongWord; filename:String; settings:TExportSet; path:String):Integer; + VAR + i:Byte; + extension:String; + BEGIN + Result:=export_noerror; + extension:=RightStr(filename,4); + IF DO_toone IN settings THEN BEGIN + ExportDatFile(fileid,path+'\'+GetWinFileName(filename)); + END ELSE BEGIN + IF DO_dat IN settings THEN ExportDatFile(fileid,path+'\'+GetWinFileName(filename)); + IF DO_raw IN settings THEN BEGIN + FOR i:=1 TO Length(ExportHandlers)+1 DO BEGIN + IF i<=Length(ExportHandlers) THEN BEGIN + IF ExportHandlers[i].Ext=extension THEN BEGIN + IF ExportHandlers[i].needed THEN BEGIN + CASE ExportHandlers[i].Handler(fileid,path+'\'+GetWinFileName(filename),(DO_convert IN settings)) OF + 0: Result:=0; + ELSE + Result:=export_handlererror; + END; + END; + Break; + END; + END ELSE BEGIN + Result:=export_nohandler; + END; + END; + END; + END; + END; + + +FUNCTION GetWinFileName(name:String):String; + BEGIN + Result:=name; + Result:=AnsiReplaceStr(Result,'\','__'); + Result:=AnsiReplaceStr(Result,'/','__'); + Result:=AnsiReplaceStr(Result,'>','__'); + Result:=AnsiReplaceStr(Result,'<','__'); + END; + +FUNCTION GetExtractPath:String; + BEGIN + Result:=ExtractFilePath(dat_filename)+'\extracted_'+ExtractFileName(dat_filename); + END; + + +PROCEDURE OpenDatabase(FileName:String); + VAR + i:Byte; + data:Tdata; + temps:String; + Tbl: TSQLiteTable; + BEGIN + IF NOT FileExists(FileName) THEN BEGIN + ShowMessage('File doesn''t exist!!!'); + Exit; + END; + DB:=TSQLiteDatabase.Create(FileName); + Tbl:=DB.GetTable('SELECT name,value FROM globals ORDER BY name ASC'); + REPEAT + IF Tbl.FieldAsString('name')='dbversion' THEN BEGIN + IF Tbl.FieldAsString('value')<>DBversion THEN BEGIN + ShowMessage('Database-file '+CrLf+'"'+FileName+'"'+CrLf+'has wrong version. (Required: '+DBversion+'; found: '+Tbl.FieldAsString('value')+')'); + Exit; + END; + END; + IF Tbl.FieldAsString('name')='lvl' THEN BEGIN + database_level:=StrToInt(Tbl.FieldAsString('value')); + END; + IF Tbl.FieldAsString('name')='ident' THEN BEGIN + temps:=Tbl.FieldAsString('value'); + FOR i:=0 TO High(database_ident) DO BEGIN + CASE temps[(i*2)+1+0] OF + '0'..'9': database_ident[i]:=Ord(temps[(i*2)+1+0])-48; + 'A'..'F': database_ident[i]:=Ord(temps[(i*2)+1+0])-55; + END; + database_ident[i]:=database_ident[i]*16; + CASE temps[(i*2)+1+1] OF + '0'..'9': database_ident[i]:=database_ident[i]+Ord(temps[(i*2)+1+0])-48; + 'A'..'F': database_ident[i]:=database_ident[i]+Ord(temps[(i*2)+1+0])-55; + END; + END; + END; + Tbl.Next; + UNTIL Tbl.EOF; + Tbl.Free; + opened_state:=opened_db; + END; + + + + +END. Index: /oup/releases/0.21a/Unit3_data.pas =================================================================== --- /oup/releases/0.21a/Unit3_data.pas (revision 21) +++ /oup/releases/0.21a/Unit3_data.pas (revision 21) @@ -0,0 +1,103 @@ +UNIT Unit3_data; +INTERFACE +USES Classes, SQLiteTable3; + +VAR + DB: TSQLiteDatabase; + +CONST + version:String='v0.21a'; + dbversion:String='0.1'; + CrLf:String[2]=#13+#10; + +TYPE + Tdata=Array OF Byte; + Theader=PACKED RECORD + Ident:Array[0..$13] OF Byte; + Files:LongWord; + NamedFiles:LongWord; + Extensions:LongWord; + DataAddr:LongWord; + DataSize:LongWord; + NamesAddr:LongWord; + NamesSize:LongWord; + Ident2:Array[0..$F] OF Byte; + END; + Tfilesmap=Array OF PACKED RECORD + Extension:Array[0..$3] OF Char; + DataAddr:LongWord; + NameAddr:LongWord; + FileSize:LongWord; + FileType:LongWord; + END; + Tfiles=Array OF PACKED RECORD + FileName:String; + Extension:String[4]; + Name:String; + Size:LongWord; + FileType:LongWord; + DatAddr:LongWord; + opened:Boolean; + END; + + Tnamedfilesmap=Array OF PACKED RECORD + FileNumber:LongWord; + blubb:LongWord; + END; + Textensionsmap=Array OF PACKED RECORD + Ident:Array[0..$7] OF Byte; + Extension:Array[0..$3] OF Char; + ExtCount:LongWord; + END; + + TAppSettings=RECORD + DatPath:String[250]; + ExtractPath:String[250]; + END; + + TExportHandlers=RECORD + Ext:String[4]; + needed:Boolean; + Handler:Function(fileid:LongWord; filename:String; convert:Boolean):Integer; + END; + + TStringList=Array OF String; + TExtList=Array OF RECORD + Ext:String; + count:LongWord; + END; + +VAR + opened_state:Byte=0; + dat_filename:String=''; + raw_filename:String=''; + dat_header:Theader; + dat_filesmap:Tfilesmap; + dat_files:Tfiles; + dat_namedfilesmap:Tnamedfilesmap; + dat_extensionsmap:Textensionsmap; + AppSettings:TAppSettings; + AppSettingsFile:File OF TAppSettings; + + database_level:LongWord; + database_ident:Array[0..$13] OF Byte; + +CONST + header_ident1:Array[0..$13] OF Byte= + ($1F,$27,$DC,$33,$DF,$BC,$03,$00,$31,$33,$52,$56,$40,$00,$14,$00,$10,$00,$08,$00); + header_ident2:Array[0..$F] OF Byte= + ($99,$CF,$40,$00,$90,$4F,$63,$00,$F4,$55,$5F,$00,$90,$4F,$63,$00); + + export_noerror:Integer=0; + export_nohandler:Integer=1; + export_handlererror:Integer=2; + export_error:Integer=3; + + opened_nothing:Byte=0; + opened_dat:Byte=1; + opened_db:Byte=2; + +IMPLEMENTATION + +END. + Index: /oup/releases/0.21a/Unit4_Exporters.pas =================================================================== --- /oup/releases/0.21a/Unit4_Exporters.pas (revision 21) +++ /oup/releases/0.21a/Unit4_Exporters.pas (revision 21) @@ -0,0 +1,196 @@ +UNIT Unit4_Exporters; +INTERFACE +USES Classes, Dialogs, StrUtils, SysUtils, Math, Unit3_data, Unit6_imgfuncs; + +PROCEDURE ExportDatFile(fileid:LongWord; filename:String); + +FUNCTION ExportSNDD(fileid:LongWord; filename:String; convert:Boolean):Integer; +FUNCTION ExportTRAC(fileid:LongWord; filename:String; convert:Boolean):Integer; +FUNCTION ExportTXAN(fileid:LongWord; filename:String; convert:Boolean):Integer; +FUNCTION ExportTXMB(fileid:LongWord; filename:String; convert:Boolean):Integer; +FUNCTION ExportTXMP(fileid:LongWord; filename:String; convert:Boolean):Integer; +VAR + ExportHandlers:Array[1..1] OF TExportHandlers=( +// (Ext:'ABNA'; needed:False), + //(Ext:'AGDB'; needed:False), + (Ext:'SNDD'; needed:True; Handler:ExportSNDD) +{ (Ext:'TRAC'; needed:True; Handler:ExportTRAC), + (Ext:'TXAN'; needed:True; Handler:ExportTXAN), + (Ext:'TXMB'; needed:True; Handler:ExportTXMB), + (Ext:'TXMP'; needed:True; Handler:ExportTXMP) +} ); + + + +IMPLEMENTATION +USES Unit2_functions; + +PROCEDURE ExportDatFile(fileid:LongWord; filename:String); + VAR + filestream:TFileStream; + data:Tdata; + BEGIN + data:=LoadDatFile(fileid); + IF FileExists(filename) THEN BEGIN + filestream:=TFileStream.Create(filename,fmOpenReadWrite); + filestream.Seek(0,soFromEnd); + END ELSE BEGIN + filestream:=TFileStream.Create(filename,fmCreate); + END; + filestream.Write(data[0],Length(data)); + filestream.Free; + END; + +FUNCTION ExportSNDD; +{ CONST + WAVheader:Array[0..0] OF Byte=( + Ord('R'),Ord('I'),Ord('F'),Ord('F'),0,0,0,0,Ord('W'),Ord('A'),Ord('V'),Ord('E'), + Ord('f'),Ord('m'),Ord('t'),Ord(' '),24,0,0,0, + ); +} TYPE + TDatData=RECORD + _fileid:LongWord; + level:LongWord; + Flag:LongWord; + FormatTag:Word; + ChanNo:Word; + SampleRate:LongWord; + BytesPSec:LongWord; + BPSample:LongWord; + BitsPS:LongWord; + Unknown:Array[1..7] OF LongWord; + Unknown2:Word; + RawSize:LongWord; + RawPos:LongWord; + END; + VAR + filestream:TFileStream; + + DatData:TDatData; + //Wave Header Stuff + ASCII_Group:LongWord; //"RIFF" + WAV_Len:LongWord; + ASCII_WAV:LongWord; //"WAVE" + ASCII_FMT:LongWord; //"fmt " + WAV_FMT_Len:LongWord; + ASCII_DATA:LongWord; //"data" + WAV_FolLen:LongWord; + + data:Tdata; + BEGIN + Result:=export_noerror; + LoadDatFilePart(fileid,0,SizeOf(DatData),@DatData); + WITH DatData DO BEGIN + //Initializing Header vars + ASCII_Group:=1179011410; // 'RIFF' + WAV_Len:=RAWSize+70; + ASCII_WAV:=1163280727; // 'WAVE' + ASCII_FMT:=544501094; // 'fmt ' + WAV_FMT_Len:=50; // 50 bytes + ASCII_DATA:=1635017060; // 'data' + WAV_FolLen:=RAWSize; + SetLength(data,RAWSize); + LoadRawFile(fileid,68,Length(data),data); + + filestream:=TFileStream.Create(filename+'.raw',fmCreate); + filestream.Write(data[0],Length(data)); + filestream.Free; + + IF convert THEN BEGIN + //Now start packing this into a neat wave... + filestream:=TFileStream.Create(filename+'.wav',fmCreate); + filestream.Write(ASCII_Group,SizeOf(ASCII_Group)); + filestream.Write(WAV_Len,SizeOf(WAV_Len)); + filestream.Write(ASCII_WAV,SizeOf(ASCII_WAV)); + filestream.Write(ASCII_FMT,SizeOf(ASCII_FMT)); + filestream.Write(WAV_FMT_Len,SizeOf(WAV_FMT_Len)); + filestream.Write(ChanNo,SizeOf(ChanNo)); + filestream.Write(Samplerate,SizeOf(Samplerate)); + filestream.Write(BytesPSec,SizeOf(BytesPSec)); + filestream.Write(BPSample,SizeOf(BPSample)); + filestream.Write(BitsPS,SizeOf(BitsPS)); + filestream.Write(Unknown[1],SizeOf(Unknown)); + filestream.Write(Unknown2,SizeOf(Unknown2)); + filestream.Write(ASCII_DATA,SizeOf(ASCII_DATA)); + filestream.Write(WAV_FolLen,SizeOf(WAV_FolLen)); + filestream.Write(data[0],Length(data)); + filestream.Free; + END; + END; + END; + +FUNCTION ExportTRAC; + VAR + link:LongWord; + linkcount:Word; + i:LongWord; + BEGIN + Result:=export_noerror; + + LoadDatFilePart(fileid,$18,SizeOf(link),@link); + link:=link DIV 256; + + LoadDatFilePart(fileid,$1E,SizeOf(linkcount),@linkcount); + FOR i:=1 TO linkcount DO BEGIN + LoadDatFilePart(fileid,$20+(i-1)*12+8,SizeOf(link),@link); + link:=link DIV 256; + END; + END; + +FUNCTION ExportTXAN; + VAR + loop_speed,unknown:Word; + linkcount:LongWord; + link:LongWord; + i:Byte; + BEGIN + Result:=export_noerror; + + LoadDatFilePart(fileid,$14,SizeOf(loop_speed),@loop_speed); + LoadDatFilePart(fileid,$16,SizeOf(unknown),@unknown); + + LoadDatFilePart(fileid,$1C,SizeOf(linkcount),@linkcount); + FOR i:=0 TO linkcount-1 DO BEGIN + LoadDatFilePart(fileid,$20+i*4,SizeOf(link),@link); + link:=link DIV 256; + IF link=0 THEN link:=fileid-1; + END; + END; + +FUNCTION ExportTXMB; + VAR + filestream:TFileStream; + img:TImgPackage; + data:Tdata; + BEGIN + Result:=export_noerror; + IF convert THEN BEGIN + img:=LoadTXMBconnected(fileid); + data:=ImgdataToBmp(img.imgx,img.imgy,img.imgdepth,img.storetype,img.imgdata); + filestream:=TFileStream.Create(filename+'.bmp',fmCreate); + filestream.Write(data[0],Length(data)); + filestream.Free; + END; + END; + +FUNCTION ExportTXMP; + VAR + filestream:TFileStream; + img:TImgPackage; + BEGIN + Result:=export_noerror; + img:=LoadImgData(fileid); + + filestream:=TFileStream.Create(filename+'.raw',fmCreate); + filestream.Write(img.imgdata[0],Length(img.imgdata)); + filestream.Free; + + IF convert THEN BEGIN + img.imgdata:=ImgdataToBMP(img.imgx,img.imgy,img.imgdepth,img.storetype,img.imgdata); + filestream:=TFileStream.Create(filename+'.bmp',fmCreate); + filestream.Write(img.imgdata[0],Length(img.imgdata)); + filestream.Free; + END; + END; + +END. Index: /oup/releases/0.21a/Unit5_preview.dfm =================================================================== --- /oup/releases/0.21a/Unit5_preview.dfm (revision 21) +++ /oup/releases/0.21a/Unit5_preview.dfm (revision 21) @@ -0,0 +1,177 @@ +object Form5: TForm5 + Left = 0 + Top = 0 + Width = 319 + Height = 181 + Caption = 'Preview' + Color = clBtnFace + Font.Charset = DEFAULT_CHARSET + Font.Color = clWindowText + Font.Height = -11 + Font.Name = 'Tahoma' + Font.Style = [] + FormStyle = fsMDIChild + OldCreateOrder = False + Visible = True + WindowState = wsMaximized + OnActivate = FormActivate + OnClose = FormClose + OnCreate = FormCreate + OnResize = FormResize + PixelsPerInch = 96 + TextHeight = 13 + object Splitter1: TSplitter + Left = 150 + Top = 0 + Width = 9 + Height = 154 + AutoSnap = False + Beveled = True + MinSize = 150 + end + object panel_preview: TPanel + Left = 159 + Top = 0 + Width = 152 + Height = 154 + Align = alClient + BevelOuter = bvNone + TabOrder = 0 + object img: TImage + Left = 0 + Top = 20 + Width = 152 + Height = 134 + Align = alClient + end + object lbl_notpossible: TLabel + Left = 16 + Top = 56 + Width = 97 + Height = 65 + AutoSize = False + Caption = 'No preview possible for this filetype' + Font.Charset = DEFAULT_CHARSET + Font.Color = clWindowText + Font.Height = -16 + Font.Name = 'Tahoma' + Font.Style = [] + ParentFont = False + Visible = False + WordWrap = True + end + object panel_buttons: TPanel + Left = 0 + Top = 0 + Width = 152 + Height = 20 + Align = alTop + BevelOuter = bvNone + TabOrder = 0 + Visible = False + OnResize = panel_buttonsResize + object btn_dec: TButton + Left = 0 + Top = 0 + Width = 20 + Height = 20 + Caption = '-' + Enabled = False + TabOrder = 0 + OnClick = btn_decClick + end + object btn_startstop: TButton + Left = 21 + Top = 0 + Width = 80 + Height = 20 + Caption = 'Stop automatic' + TabOrder = 1 + OnClick = btn_startstopClick + end + object btn_inc: TButton + Left = 102 + Top = 0 + Width = 20 + Height = 20 + Caption = '+' + Enabled = False + TabOrder = 2 + OnClick = btn_incClick + end + end + end + object panel_files: TPanel + Left = 0 + Top = 0 + Width = 150 + Height = 154 + Align = alLeft + BevelOuter = bvNone + TabOrder = 1 + object list: TListBox + Left = 0 + Top = 0 + Width = 150 + Height = 129 + Align = alClient + ItemHeight = 13 + PopupMenu = popup + TabOrder = 0 + OnClick = listClick + end + object panel_extension: TPanel + Left = 0 + Top = 129 + Width = 150 + Height = 25 + Align = alBottom + BevelOuter = bvNone + TabOrder = 1 + OnResize = panel_extensionResize + object combo_extension: TComboBox + Left = 2 + Top = 2 + Width = 145 + Height = 21 + Style = csDropDownList + DropDownCount = 12 + Font.Charset = DEFAULT_CHARSET + Font.Color = clWindowText + Font.Height = -11 + Font.Name = 'Tahoma' + Font.Style = [] + ItemHeight = 0 + ParentFont = False + Sorted = True + TabOrder = 0 + OnClick = combo_extensionClick + end + end + end + object timer: TTimer + Enabled = False + OnTimer = timerTimer + Left = 144 + Top = 24 + end + object popup: TPopupMenu + AutoHotkeys = maManual + Left = 48 + Top = 56 + object popup_extractdat: TMenuItem + Caption = 'Extract .dat-file' + Enabled = False + end + object popup_extractdatraw: TMenuItem + Caption = 'Extract .dat-file and corresponding .raw-data' + Enabled = False + end + object popup_extractdatrawconvert: TMenuItem + Caption = + 'Extract .dat-file and corresponding .raw-data and convert if pos' + + 'sible' + Enabled = False + end + end +end Index: /oup/releases/0.21a/Unit5_preview.pas =================================================================== --- /oup/releases/0.21a/Unit5_preview.pas (revision 21) +++ /oup/releases/0.21a/Unit5_preview.pas (revision 21) @@ -0,0 +1,257 @@ +UNIT Unit5_preview; +INTERFACE +USES + Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, + Dialogs, Math, ExtCtrls, Unit2_functions, Unit3_data, Unit4_exporters, Unit6_imgfuncs, + StdCtrls, StrUtils, Menus; + +TYPE + TForm5 = Class(TForm) + timer: TTimer; + panel_preview: TPanel; + img: TImage; + panel_buttons: TPanel; + btn_dec: TButton; + btn_startstop: TButton; + btn_inc: TButton; + panel_files: TPanel; + list: TListBox; + panel_extension: TPanel; + combo_extension: TComboBox; + Splitter1: TSplitter; + lbl_notpossible: TLabel; + popup: TPopupMenu; + popup_extractdat: TMenuItem; + popup_extractdatraw: TMenuItem; + popup_extractdatrawconvert: TMenuItem; + procedure FormActivate(Sender: TObject); + PROCEDURE Recreatelist; + PROCEDURE listClick(Sender: TObject); + PROCEDURE PreviewTXAN; + PROCEDURE PreviewTXMB; + PROCEDURE PreviewTXMP; + PROCEDURE panel_extensionResize(Sender: TObject); + PROCEDURE combo_extensionClick(Sender: TObject); + PROCEDURE btn_incClick(Sender: TObject); + PROCEDURE btn_decClick(Sender: TObject); + PROCEDURE FormResize(Sender: TObject); + PROCEDURE btn_startstopClick(Sender: TObject); + PROCEDURE panel_buttonsResize(Sender: TObject); + PROCEDURE timerTimer(Sender: TObject); + PROCEDURE FormCreate(Sender: TObject); + PROCEDURE FormClose(Sender: TObject; var Action: TCloseAction); + PRIVATE + PUBLIC + END; + +VAR + Form5: TForm5; + +IMPLEMENTATION +{$R *.dfm} +USES Unit1_main; +VAR + memstreams:Array OF TMemoryStream; + actualimg:Byte; + _fileid:LongWord; + + +PROCEDURE TForm5.Recreatelist; + VAR + i:LongWord; + exts:TStringList; + BEGIN + combo_extension.Items.Clear; + combo_extension.Items.Add('_All files_ ('{+IntToStr(dat_header.Files)}+')'); + exts:=GetExtensionsList; + FOR i:=0 TO High(exts) DO + combo_extension.Items.Add(exts[i]); + combo_extension.ItemIndex:=0; + combo_extensionClick(Self); + END; + + +PROCEDURE TForm5.listClick(Sender: TObject); + BEGIN + _fileid:=StrToInt(MidStr(list.Items.Strings[list.ItemIndex],1,5)); + lbl_notpossible.Visible:=False; + Self.img.Visible:=True; + Self.timer.Enabled:=False; + Self.panel_buttons.Visible:=False; + IF RightStr(list.Items.Strings[list.ItemIndex],4)='TXAN' THEN PreviewTXAN + ELSE + IF RightStr(list.Items.Strings[list.ItemIndex],4)='TXMB' THEN PreviewTXMB + ELSE + IF RightStr(list.Items.Strings[list.ItemIndex],4)='TXMP' THEN PreviewTXMP + ELSE BEGIN + Self.lbl_notpossible.Visible:=True; + Self.img.Visible:=False; + END; + END; + + +PROCEDURE TForm5.panel_extensionResize(Sender: TObject); + BEGIN + combo_extension.Width:=panel_extension.Width-5; + END; + + +PROCEDURE TForm5.combo_extensionClick(Sender: TObject); + VAR + Extension:String[4]; + files:TStringList; + i:LongWord; + BEGIN + Extension:=MidStr(combo_extension.Items.Strings[combo_extension.ItemIndex],1,4); + list.Items.Clear; + IF Extension='_All' THEN + files:=GetFilesList('','',True) + ELSE + files:=GetFilesList(extension,'',True); + IF Length(files)>0 THEN + FOR i:=0 TO High(files) DO + list.Items.Add(files[i]); + END; + + +PROCEDURE TForm5.PreviewTXMB; + VAR + data:Tdata; + img:TImgPackage; + BEGIN + SetLength(memstreams,1); + img:=LoadTXMBconnected(_fileid); + data:=ImgdataToBmp(img.imgx,img.imgy,img.imgdepth,img.storetype,img.imgdata); + + memstreams[0].Clear; + memstreams[0].Write(data[0],Length(data)); + memstreams[0].Seek(0,soFromBeginning); + + Self.img.Picture.Bitmap.LoadFromStream(memstreams[0]); + END; + +PROCEDURE TForm5.PreviewTXMP; + VAR + data:Tdata; + img:TImgPackage; + BEGIN + SetLength(memstreams,1); + img:=LoadImgData(_fileid); + data:=ImgdataToBmp(img.imgx,img.imgy,img.imgdepth,img.storetype,img.imgdata); + + memstreams[0].Clear; + memstreams[0].Write(data[0],Length(data)); + memstreams[0].Seek(0,soFromBeginning); + + Self.img.Picture.Bitmap.LoadFromStream(memstreams[0]); + END; + +PROCEDURE TForm5.PreviewTXAN; + VAR + loop_speed:Word; + linkcount:LongWord; + link:LongWord; + i:Byte; + data:Tdata; + img:TImgPackage; + BEGIN + LoadDatFilePart(_fileid,$14,SizeOf(loop_speed),@loop_speed); + LoadDatFilePart(_fileid,$1C,SizeOf(linkcount),@linkcount); + SetLength(memstreams,linkcount); + FOR i:=0 TO linkcount-1 DO BEGIN + LoadDatFilePart(_fileid,$20+i*4,SizeOf(link),@link); + link:=link DIV 256; + IF link=0 THEN link:=_fileid-1; + memstreams[i]:=TMemoryStream.Create; + img:=LoadImgData(link); + data:=ImgdataToBmp(img.imgx,img.imgy,img.imgdepth,img.storetype,img.imgdata); + memstreams[i].Clear; + memstreams[i].Write(data[0],Length(data)); + memstreams[i].Seek(0,soFromBeginning); + END; + actualimg:=254; + Self.timer.Interval:=Floor(loop_speed*(1/60)*1000); + Self.timer.Enabled:=False; + Self.btn_startstopClick(Self); + Self.panel_buttons.Visible:=True; + END; + + +PROCEDURE TForm5.FormCreate(Sender: TObject); + BEGIN + SetLength(memstreams,1); + memstreams[0]:=TMemoryStream.Create; + Self.Width:=260; + Self.Height:=300; + END; + +PROCEDURE TForm5.timerTimer(Sender: TObject); + BEGIN + Inc(actualimg); + IF actualimg>=Length(memstreams) THEN actualimg:=0; + Self.img.Picture.Bitmap.LoadFromStream(memstreams[actualimg]); + memstreams[actualimg].Seek(0,soFromBeginning); + Self.Caption:='Preview '+dat_files[_fileid].FileName+' ('+IntToStr(actualimg+1)+'/'+IntToStr(Length(memstreams))+')'; + END; + +PROCEDURE TForm5.panel_buttonsResize(Sender: TObject); + BEGIN + btn_startstop.Width:=panel_buttons.Width-45; + btn_inc.Left:=panel_buttons.Width-23; + END; + +PROCEDURE TForm5.btn_startstopClick(Sender: TObject); + BEGIN + Self.timer.Enabled:=NOT Self.timer.Enabled; + Self.btn_dec.Enabled:=NOT Self.timer.Enabled; + Self.btn_inc.Enabled:=NOT Self.timer.Enabled; + IF Self.timer.Enabled THEN + Self.btn_startstop.Caption:='Stop automatic' + ELSE + Self.btn_startstop.Caption:='Start automatic'; + END; + +PROCEDURE TForm5.FormResize(Sender: TObject); + BEGIN + IF Self.Width>=300 THEN BEGIN + END ELSE Self.Width:=300; + IF Self.Height>=200 THEN BEGIN + END ELSE Self.Height:=200; + END; + +PROCEDURE TForm5.btn_decClick(Sender: TObject); + BEGIN + IF actualimg>0 THEN + Dec(actualimg) + ELSE + actualimg:=High(memstreams); + Self.Caption:='Preview '+dat_files[_fileid].FileName+' ('+IntToStr(actualimg+1)+'/'+IntToStr(Length(memstreams))+')'; + Self.img.Picture.Bitmap.LoadFromStream(memstreams[actualimg]); + memstreams[actualimg].Seek(0,soFromBeginning); + END; + +PROCEDURE TForm5.btn_incClick(Sender: TObject); + BEGIN + IF actualimg0) THEN BEGIN + Inc(row_orig); + IF (row_orig MOD 2)=0 THEN BEGIN + Inc(row); + col:=0; + END; + END; + IF (row_orig MOD 2)=0 THEN BEGIN + IF (i MOD 2)=0 THEN BEGIN + FOR j:=0 TO (imgdepth DIV 8)-1 DO + temparray[((row*(oldx DIV 2))+col)*(imgdepth DIV 8)+j]:=data[i*2+j]; + Inc(col); + END; + END; + END; + Result:=temparray; + END; + + +FUNCTION RevertImage(imgx,imgy,imgdepth:LongWord; imgdata:Tdata):Tdata; + VAR + x,y,i:LongWord; + BEGIN + SetLength(Result,imgx*imgy*(imgdepth DIV 8)); + FOR y:=0 TO imgy-1 DO + FOR x:=0 TO imgx-1 DO + FOR i:=0 TO (imgdepth DIV 8)-1 DO + Result[((imgx*(imgy-1-y)+x)*(imgdepth DIV 8))+i]:= + imgdata[(imgx*y+x)*(imgdepth DIV 8)+i]; + END; + + +FUNCTION DecompressImage(imgx,imgy:LongWord; imgdata:Tdata):Tdata; + TYPE + Tcolor=RECORD + RGBb:Byte; + RGBg:Byte; + RGBr:Byte; + RGBa:Byte; + END; + VAR + i,j,x,y:LongWord; + color:Array[1..4] OF Tcolor; + pixel:Array[1..16] OF Byte; + BEGIN + x:=0; + y:=0; + SetLength(Result,imgx*imgy*4); + FOR i:=0 TO ((imgx*imgy) DIV 16)-1 DO BEGIN + Color[1].RGBb:=Floor(((imgdata[(i*8)+0]+imgdata[(i*8)+1]*256) AND $001F) / $001F * 255); + Color[1].RGBg:=Floor(((imgdata[(i*8)+0]+imgdata[(i*8)+1]*256) AND $07E0) / $07E0 * 255); + Color[1].RGBr:=Floor(((imgdata[(i*8)+0]+imgdata[(i*8)+1]*256) AND $F800) / $F800 * 255); + Color[1].RGBa:=255; + Color[2].RGBb:=Floor(((imgdata[(i*8)+2]+imgdata[(i*8)+3]*256) AND $001F) / $001F * 255); + Color[2].RGBg:=Floor(((imgdata[(i*8)+2]+imgdata[(i*8)+3]*256) AND $07E0) / $07E0 * 255); + Color[2].RGBr:=Floor(((imgdata[(i*8)+2]+imgdata[(i*8)+3]*256) AND $F800) / $F800 * 255); + Color[2].RGBa:=255; + Color[3].RGBb:=Floor( Color[1].RGBb/3*2 + Color[2].RGBb/3 ); + Color[3].RGBg:=Floor( Color[1].RGBg/3*2 + Color[2].RGBg/3 ); + Color[3].RGBr:=Floor( Color[1].RGBr/3*2 + Color[2].RGBr/3 ); + Color[3].RGBa:=255; + Color[4].RGBb:=Floor( Color[1].RGBb/3 + Color[2].RGBb/3*2 ); + Color[4].RGBg:=Floor( Color[1].RGBg/3 + Color[2].RGBg/3*2 ); + Color[4].RGBr:=Floor( Color[1].RGBr/3 + Color[2].RGBr/3*2 ); + Color[4].RGBa:=255; + Pixel[1]:=Floor( (imgdata[(i*8)+4] AND $C0) / $40 + 1 ); + Pixel[2]:=Floor( (imgdata[(i*8)+4] AND $30) / $10 + 1 ); + Pixel[3]:=Floor( (imgdata[(i*8)+4] AND $0C) / $04 + 1 ); + Pixel[4]:=Floor( (imgdata[(i*8)+4] AND $03) + 1 ); + Pixel[5]:=Floor( (imgdata[(i*8)+5] AND $C0) / $40 + 1 ); + Pixel[6]:=Floor( (imgdata[(i*8)+5] AND $30) / $10 + 1 ); + Pixel[7]:=Floor( (imgdata[(i*8)+5] AND $0C) / $04 + 1 ); + Pixel[8]:=Floor( (imgdata[(i*8)+5] AND $03) + 1 ); + Pixel[9]:=Floor( (imgdata[(i*8)+6] AND $C0) / $40 + 1 ); + Pixel[10]:=Floor( (imgdata[(i*8)+6] AND $30) / $10 + 1 ); + Pixel[11]:=Floor( (imgdata[(i*8)+6] AND $0C) / $04 + 1 ); + Pixel[12]:=Floor( (imgdata[(i*8)+6] AND $03) + 1 ); + Pixel[13]:=Floor( (imgdata[(i*8)+7] AND $C0) / $40 + 1 ); + Pixel[14]:=Floor( (imgdata[(i*8)+7] AND $30) / $10 + 1 ); + Pixel[15]:=Floor( (imgdata[(i*8)+7] AND $0C) / $04 + 1 ); + Pixel[16]:=Floor( (imgdata[(i*8)+7] AND $03) + 1 ); + FOR j:=0 TO 3 DO BEGIN + Result[((y+3)*imgx+x+j)*3+0]:=Color[Pixel[16-j]].RGBb; + Result[((y+3)*imgx+x+j)*3+1]:=Color[Pixel[16-j]].RGBg; + Result[((y+3)*imgx+x+j)*3+2]:=Color[Pixel[16-j]].RGBr; + END; + FOR j:=0 TO 3 DO BEGIN + Result[((y+2)*imgx+x+j)*3+0]:=Color[Pixel[12-j]].RGBb; + Result[((y+2)*imgx+x+j)*3+1]:=Color[Pixel[12-j]].RGBg; + Result[((y+2)*imgx+x+j)*3+2]:=Color[Pixel[12-j]].RGBr; + END; + FOR j:=0 TO 3 DO BEGIN + Result[((y+1)*imgx+x+j)*3+0]:=Color[Pixel[8-j]].RGBb; + Result[((y+1)*imgx+x+j)*3+1]:=Color[Pixel[8-j]].RGBg; + Result[((y+1)*imgx+x+j)*3+2]:=Color[Pixel[8-j]].RGBr; + END; + FOR j:=0 TO 3 DO BEGIN + Result[((y+0)*imgx+x+j)*3+0]:=Color[Pixel[4-j]].RGBb; + Result[((y+0)*imgx+x+j)*3+1]:=Color[Pixel[4-j]].RGBg; + Result[((y+0)*imgx+x+j)*3+2]:=Color[Pixel[4-j]].RGBr; + END; + x:=x+4; + IF x=imgx THEN BEGIN + y:=y+4; + x:=0; + END; + END; + END; + + +FUNCTION ImgdataToBmp(imgx,imgy,imgdepth,storetype:LongWord; imgdata:Tdata):Tdata; + CONST BMPheader:Array[0..53] OF Byte= + ($42,$4D,0,0,0,0,0,0,0,0,54,0,0,0, + 40,0,0,0,0,0,0,0,0,0,0,0,1,0,$18,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0); + VAR + i,x,y:LongWord; + BEGIN + CASE storetype OF + 0: BEGIN + SetLength(Result,imgx*imgy*3); + FOR y:=0 TO imgy-1 DO BEGIN + FOR x:=0 TO imgx-1 DO BEGIN + Result[((imgx*y+x)*3)+0]:=Floor( ( (imgdata[(imgx*y+x)*2]+imgdata[(imgx*y+x)*2+1]*256) AND $000F ) / $000F * 255); + Result[((imgx*y+x)*3)+1]:=Floor( ( (imgdata[(imgx*y+x)*2]+imgdata[(imgx*y+x)*2+1]*256) AND $00F0 ) / $00F0 * 255); + Result[((imgx*y+x)*3)+2]:=Floor( ( (imgdata[(imgx*y+x)*2]+imgdata[(imgx*y+x)*2+1]*256) AND $0F00 ) / $0F00 * 255); + END; + END; + END; + 1,2: BEGIN + SetLength(Result,imgx*imgy*3); + FOR y:=0 TO imgy-1 DO BEGIN + FOR x:=0 TO imgx-1 DO BEGIN + Result[((imgx*y+x)*3)+0]:=Floor( ( (imgdata[(imgx*y+x)*2]+imgdata[(imgx*y+x)*2+1]*256) AND $001F ) / $001F * 255); + Result[((imgx*y+x)*3)+1]:=Floor( ( (imgdata[(imgx*y+x)*2]+imgdata[(imgx*y+x)*2+1]*256) AND $03E0 ) / $03E0 * 255); + Result[((imgx*y+x)*3)+2]:=Floor( ( (imgdata[(imgx*y+x)*2]+imgdata[(imgx*y+x)*2+1]*256) AND $7C00 ) / $7C00 * 255); + END; + END; + END; + 8: BEGIN + SetLength(Result,imgx*imgy*3); + FOR y:=0 TO imgy-1 DO BEGIN + FOR x:=0 TO imgx-1 DO BEGIN + Result[((imgx*y+x)*3)+0]:=imgdata[(imgx*y+x)*4+0]; + Result[((imgx*y+x)*3)+1]:=imgdata[(imgx*y+x)*4+1]; + Result[((imgx*y+x)*3)+2]:=imgdata[(imgx*y+x)*4+2]; + END; + END; + END; + 9: BEGIN + Result:=DecompressImage(imgx,imgy,imgdata); + END; + END; + Result:=RevertImage(imgx,imgy,24,Result); + SetLength(Result,imgx*imgy*3+54); + FOR i:=High(Result)-54 DOWNTO 0 DO Result[i+54]:=Result[i]; + + FOR i:=0 TO High(BMPheader) DO Result[i]:=BMPheader[i]; + Result[2]:=((imgx*imgy*3+54) AND $000000FF); + Result[3]:=((imgx*imgy*3+54) AND $0000FF00) DIV $100; + Result[4]:=((imgx*imgy*3+54) AND $00FF0000) DIV $10000; + Result[5]:=((imgx*imgy*3+54) AND $FF000000) DIV $1000000; + Result[18]:=(imgx AND $000000FF) DIV $1; + Result[19]:=(imgx AND $0000FF00) DIV $100; + Result[20]:=(imgx AND $00FF0000) DIV $10000; + Result[21]:=(imgx AND $FF000000) DIV $1000000; + Result[22]:=(imgy AND $000000FF) DIV $1; + Result[23]:=(imgy AND $0000FF00) DIV $100; + Result[24]:=(imgy AND $00FF0000) DIV $10000; + Result[25]:=(imgy AND $FF000000) DIV $1000000; + Result[34]:=((imgx*imgy*3) AND $000000FF) DIV $1; + Result[35]:=((imgx*imgy*3) AND $0000FF00) DIV $100; + Result[36]:=((imgx*imgy*3) AND $00FF0000) DIV $10000; + Result[37]:=((imgx*imgy*3) AND $FF000000) DIV $1000000; + END; + +FUNCTION BmpToImgdata(bmpdata:Tdata; _32bit:Boolean):TImgPackage; + VAR + x,y:LongWord; + r24,g24,b24:Word; + r16,g16,b16:Word; + gesamt:Word; + BEGIN + Result.imgdepth:=0; + IF NOT((bmpdata[00]=$42) AND (bmpdata[01]=$4D)) THEN BEGIN + ShowMessage('Not a standard 24bit bitmap'); + Exit; + END; + IF NOT(bmpdata[10]=54) THEN BEGIN + ShowMessage('Imagedata has to start at 0x54'); + Exit; + END; + IF NOT(bmpdata[14]=40) THEN BEGIN + ShowMessage('Second bitmap header has to have 40 bytes'); + Exit; + END; + IF NOT(bmpdata[28]=24) THEN BEGIN + ShowMessage('Bitmap has to have 24bits'); + Exit; + END; + IF NOT(bmpdata[30]=0) THEN BEGIN + ShowMessage('Bitmap has to be uncompressed'); + Exit; + END; + Result.imgx:=bmpdata[18]+bmpdata[19]*256+bmpdata[20]*256*256+bmpdata[21]*256*256*256; + Result.imgy:=bmpdata[22]+bmpdata[23]*256+bmpdata[24]*256*256+bmpdata[25]*256*256*256; + IF _32bit THEN BEGIN + Result.imgdepth:=32; + Result.storetype:=8; + END ELSE BEGIN + Result.imgdepth:=16; + Result.storetype:=1; + END; + + SetLength(Result.imgdata,Result.imgx*Result.imgy*Result.imgdepth DIV 8); + IF _32bit THEN BEGIN + FOR y:=0 TO Result.imgy-1 DO BEGIN + FOR x:=0 TO Result.imgx-1 DO BEGIN + Result.imgdata[((Result.imgx*y+x)*4)+0]:=bmpdata[54+(Result.imgx*y+x)*3+0]; + Result.imgdata[((Result.imgx*y+x)*4)+1]:=bmpdata[54+(Result.imgx*y+x)*3+1]; + Result.imgdata[((Result.imgx*y+x)*4)+2]:=bmpdata[54+(Result.imgx*y+x)*3+2]; + Result.imgdata[((Result.imgx*y+x)*4)+3]:=0; + END; + END; + END ELSE BEGIN + FOR y:=0 TO Result.imgy-1 DO BEGIN + FOR x:=0 TO Result.imgx-1 DO BEGIN + r24:=bmpdata[54+(Result.imgx*y+x)*3+0]; + g24:=bmpdata[54+(Result.imgx*y+x)*3+1]; + b24:=bmpdata[54+(Result.imgx*y+x)*3+2]; + r16:=(Ceil(r24*$001F/255)) AND $001F; + g16:=(Ceil(g24*$03E0/255)) AND $03E0; + b16:=(Ceil(b24*$7C00/255)) AND $7C00; + gesamt:=r16+g16+b16; + Result.imgdata[((Result.imgx*y+x)*2)+0]:=gesamt AND $00FF; + Result.imgdata[((Result.imgx*y+x)*2)+1]:=(gesamt AND $FF00) DIV 256; + END; + END; + END; + + Result.imgdata:=RevertImage(Result.imgx,Result.imgy,Result.imgdepth,Result.imgdata); + END; + +FUNCTION LoadTXMBconnected(fileid:LongWord):TImgPackage; + VAR + i,x,y,x2,y2,pixelid,imgid:LongWord; + rows,cols:Word; + linkcount:LongWord; + link:LongWord; + single_image:TImgPackage; + images_decoded:Array OF TImgPackage; + x_start,y_start:LongWord; + BEGIN + LoadDatFilePart(fileid,$10,SizeOf(Result.imgx),@Result.imgx); + LoadDatFilePart(fileid,$12,SizeOf(Result.imgy),@Result.imgy); + LoadDatFilePart(fileid,$18,SizeOf(cols),@cols); + LoadDatFilePart(fileid,$1A,SizeOf(rows),@rows); + LoadDatFilePart(fileid,$1C,SizeOf(linkcount),@linkcount); + SetLength(images_decoded,linkcount); + FOR i:=0 TO linkcount-1 DO BEGIN + LoadDatFilePart(fileid,$20+i*4,SizeOf(link),@link); + link:=link DIV 256; + single_image:=LoadImgData(link); + images_decoded[i]:=BmpToImgdata(ImgdataToBmp(single_image.imgx,single_image.imgy,single_image.imgdepth,single_image.storetype,single_image.imgdata),False); + END; + SetLength(Result.imgdata,Result.imgx*Result.imgy*2); + FOR y:=0 TO rows-1 DO BEGIN + FOR x:=0 TO cols-1 DO BEGIN + imgid:=y*cols+x; + x_start:=0; + y_start:=0; + FOR i:=0 TO x DO IF i0 THEN + FOR i:=0 TO High(files) DO + list_txmp.Items.Add(files[i]); + group_bmpselect.Enabled:=False; + check_transparency.Checked:=False; + check_fading.Checked:=False; + END; + + +PROCEDURE TForm7.FormResize(Sender: TObject); + BEGIN + IF Self.Width>=400 THEN BEGIN + END ELSE Self.Width:=400; + IF Self.Height>=350 THEN BEGIN + END ELSE Self.Height:=350; + END; + +PROCEDURE TForm7.list_txmpClick(Sender: TObject); + VAR + id:LongWord; + data:Tdata; + img:TImgPackage; + mem:TMemoryStream; + fadingbyte,depthbyte,storebyte:Byte; + BEGIN + id:=StrToInt(MidStr(list_txmp.Items.Strings[list_txmp.ItemIndex],1,5)); + + LoadDatFilePart(id,$88,SizeOf(fadingbyte),@fadingbyte); + LoadDatFilePart(id,$89,SizeOf(depthbyte),@depthbyte); + LoadDatFilePart(id,$90,SizeOf(storebyte),@storebyte); + check_fading.Checked:=(fadingbyte AND $01)>0; + check_transparency.Checked:=(depthbyte AND $04)>0; + check_32bit.Checked:=(storebyte=8); + + img:=LoadImgData(id); + data:=ImgdataToBmp(img.imgx,img.imgy,img.imgdepth,img.storetype,img.imgdata); + + mem:=TMemoryStream.Create; + mem.Write(data[0],Length(data)); + mem.Seek(0,soFromBeginning); + image_txmppreview.Picture.Bitmap.LoadFromStream(mem); + mem.Free; + + group_bmpselect.Enabled:=True; + END; + +PROCEDURE TForm7.btn_loadClick(Sender: TObject); + VAR + bmpfile:TFileStream; + mem:TMemoryStream; + BEGIN + IF opend.Execute THEN BEGIN + bmpfile:=TFileStream.Create(opend.FileName, fmOpenRead); + SetLength(actual_bmpdata,bmpfile.Size); + bmpfile.Read(actual_bmpdata[0],bmpfile.Size); + bmpfile.Free; + + mem:=TMemoryStream.Create; + mem.Write(actual_bmpdata[0],Length(actual_bmpdata)); + mem.Seek(0,soFromBeginning); + image_bmppreview.Picture.Bitmap.LoadFromStream(mem); + mem.Free; + + group_options.Enabled:=True; + END; + END; + +PROCEDURE TForm7.btn_replaceClick(Sender: TObject); + VAR + id:LongWord; + imgpkg:TImgPackage; + rawfile:TFileStream; + dataddr:LongWord; + old_rawaddr,new_rawaddr:LongWord; + oldwidth,oldheight:Word; + oldstore,olddepth,oldfading:Byte; + oldsize:LongWord; + newsize:LongWord; + datbyte:Word; + BEGIN + IF list_txmp.ItemIndex>=0 THEN BEGIN + imgpkg:=BmpToImgdata(actual_bmpdata,check_32bit.Checked); + + id:=StrToInt(MidStr(list_txmp.Items.Strings[list_txmp.ItemIndex],1,5)); + LoadDatFilePart(id,$8C,2,@oldwidth); + LoadDatFilePart(id,$8E,2,@oldheight); + LoadDatFilePart(id,$88,1,@oldfading); + LoadDatFilePart(id,$89,1,@olddepth); + LoadDatFilePart(id,$90,1,@oldstore); + LoadDatFilePart(id,$9C,4,@old_rawaddr); + IF (oldwidth<>imgpkg.imgx) OR (oldheight<>imgpkg.imgy) THEN BEGIN + IF MessageBox(Self.Handle, + PChar('Current image and new image have different size'+CrLf+ + '(Current: '+IntToStr(oldwidth)+'x'+IntToStr(oldheight)+ + ' - New: '+IntToStr(imgpkg.imgx)+'x'+IntToStr(imgpkg.imgy)+')'+CrLf+ + 'Replace anyways?'), + PChar(list_txmp.Items.Strings[list_txmp.ItemIndex]), + MB_YESNO)=IDNO THEN Exit; + END; + + rawfile:=TFileStream.Create(raw_filename,fmOpenReadWrite); + + CASE oldstore OF + 9: oldsize:=GetImageDataSize(oldwidth,oldheight,8,(oldfading AND $01)>0); + 0,1,2: oldsize:=GetImageDataSize(oldwidth,oldheight,16,(oldfading AND $01)>0); + 8: oldsize:=GetImageDataSize(oldwidth,oldheight,32,(oldfading AND $01)>0); + ELSE + oldsize:=0; + END; + IF check_32bit.Checked THEN + newsize:=GetImageDataSize(imgpkg.imgx,imgpkg.imgy,32,check_fading.Checked) + ELSE + newsize:=GetImageDataSize(imgpkg.imgx,imgpkg.imgy,16,check_fading.Checked); + + IF newsize<=oldsize THEN + new_rawaddr:=old_rawaddr + ELSE + new_rawaddr:=rawfile.Size; + + datbyte:=$00; + IF check_fading.Checked THEN datbyte:=datbyte OR $01; + UpdateDatFilePart(id,$88,1,@datbyte); + datbyte:=$10; + IF check_transparency.Checked THEN datbyte:=datbyte OR $04; + UpdateDatFilePart(id,$89,1,@datbyte); + UpdateDatFilePart(id,$8C,2,@imgpkg.imgx); + UpdateDatFilePart(id,$8E,2,@imgpkg.imgy); + IF check_32bit.Checked THEN + datbyte:=$08 + ELSE + datbyte:=$01; + UpdateDatFilePart(id,$90,1,@datbyte); + UpdateDatFilePart(id,$9C,4,@new_rawaddr); + + IF check_fading.Checked THEN BEGIN + imgpkg.imgdata:=CreateFadedImage(imgpkg); + END; + + rawfile.Seek(new_rawaddr,soFromBeginning); + rawfile.Write(imgpkg.imgdata[0],Length(imgpkg.imgdata)); + rawfile.Free; + + ShowMessage('TXMP-image replaced'); + END; + END; + +PROCEDURE TForm7.FormClose(Sender: TObject; var Action: TCloseAction); + BEGIN + Action:=caFree; + Form1.close_window(Self.Name); + END; + +PROCEDURE TForm7.FormActivate(Sender: TObject); + BEGIN + Form1.SetActiveWindow(Self.Name); + END; + +PROCEDURE TForm7.btn_saveClick(Sender: TObject); + VAR + filestream:TFileStream; + img:TImgPackage; + BEGIN + IF saved.Execute THEN BEGIN + img:=LoadImgData(StrToInt(MidStr(list_txmp.Items.Strings[list_txmp.ItemIndex],1,5))); + img.imgdata:=ImgdataToBMP(img.imgx,img.imgy,img.imgdepth,img.storetype,img.imgdata); + filestream:=TFileStream.Create(saved.FileName,fmCreate); + filestream.Write(img.imgdata[0],Length(img.imgdata)); + filestream.Free; + END; + END; + +END. Index: /oup/releases/0.21a/Unit8_binedit.dfm =================================================================== --- /oup/releases/0.21a/Unit8_binedit.dfm (revision 21) +++ /oup/releases/0.21a/Unit8_binedit.dfm (revision 21) @@ -0,0 +1,207 @@ +object Form8: TForm8 + Left = 0 + Top = 0 + Width = 650 + Height = 450 + Caption = 'Binary .dat-Editor' + Color = clBtnFace + Font.Charset = DEFAULT_CHARSET + Font.Color = clWindowText + Font.Height = -11 + Font.Name = 'Tahoma' + Font.Style = [] + FormStyle = fsMDIChild + OldCreateOrder = False + Visible = True + WindowState = wsMaximized + OnActivate = FormActivate + OnClose = FormClose + OnCloseQuery = FormCloseQuery + OnCreate = FormCreate + OnResize = FormResize + PixelsPerInch = 96 + TextHeight = 13 + object Splitter1: TSplitter + Left = 150 + Top = 0 + Width = 9 + Height = 423 + AutoSnap = False + Beveled = True + MinSize = 150 + end + object panel_data: TPanel + Left = 159 + Top = 0 + Width = 483 + Height = 423 + Align = alClient + BevelOuter = bvNone + TabOrder = 0 + OnResize = panel_dataResize + object Splitter2: TSplitter + Left = 0 + Top = 300 + Width = 483 + Height = 9 + Cursor = crVSplit + Align = alTop + AutoSnap = False + Beveled = True + MinSize = 50 + end + object hex: TMPHexEditor + Left = 0 + Top = 0 + Width = 483 + Height = 300 + Cursor = crIBeam + Align = alTop + Font.Charset = DEFAULT_CHARSET + Font.Color = clWindowText + Font.Height = -16 + Font.Name = 'Courier' + Font.Style = [] + ParentFont = False + TabOrder = 0 + BytesPerRow = 16 + Translation = tkASCII + OffsetFormat = '6!10:0x|' + Colors.Background = clWindow + Colors.ChangedBackground = clWindow + Colors.ChangedText = clRed + Colors.CursorFrame = clNavy + Colors.Offset = clBlack + Colors.OddColumn = clBlue + Colors.EvenColumn = clNavy + Colors.CurrentOffsetBackground = clBtnShadow + Colors.OffsetBackGround = clBtnFace + Colors.CurrentOffset = clBtnHighlight + Colors.Grid = clBtnFace + Colors.NonFocusCursorFrame = clAqua + Colors.ActiveFieldBackground = clWindow + FocusFrame = True + AllowInsertMode = False + DrawGridLines = False + Version = 'May 23, 2005; '#169' markus stephany, vcl[at]mirkes[dot]de' + OnChange = hexChange + ShowPositionIfNotFocused = True + OnSelectionChanged = hexSelectionChanged + end + object structs: TWrapGrid + Left = 0 + Top = 309 + Width = 483 + Height = 114 + Align = alClient + DefaultColWidth = 92 + DefaultRowHeight = 18 + FixedCols = 0 + Options = [goFixedVertLine, goFixedHorzLine, goVertLine, goHorzLine, goColSizing] + TabOrder = 1 + OnClick = structsClick + end + end + object panel_files: TPanel + Left = 0 + Top = 0 + Width = 150 + Height = 423 + Align = alLeft + BevelOuter = bvNone + TabOrder = 1 + object Bevel1: TBevel + Left = 0 + Top = 359 + Width = 150 + Height = 6 + Align = alBottom + Style = bsRaised + end + object list: TListBox + Left = 0 + Top = 0 + Width = 150 + Height = 315 + Align = alClient + ItemHeight = 13 + TabOrder = 0 + OnClick = listClick + end + object panel_extension: TPanel + Left = 0 + Top = 315 + Width = 150 + Height = 44 + Align = alBottom + BevelOuter = bvNone + TabOrder = 1 + OnResize = panel_extensionResize + object lbl_filter: TLabel + Left = 2 + Top = 4 + Width = 100 + Height = 17 + AutoSize = False + Caption = '&Filter by extension:' + FocusControl = combo_extension + end + object combo_extension: TComboBox + Left = 2 + Top = 20 + Width = 145 + Height = 21 + Style = csDropDownList + DropDownCount = 12 + Font.Charset = DEFAULT_CHARSET + Font.Color = clWindowText + Font.Height = -11 + Font.Name = 'Tahoma' + Font.Style = [] + ItemHeight = 13 + ParentFont = False + Sorted = True + TabOrder = 0 + OnClick = combo_extensionClick + end + end + object panel_imexport: TPanel + Left = 0 + Top = 365 + Width = 150 + Height = 58 + Align = alBottom + BevelOuter = bvNone + TabOrder = 2 + OnResize = panel_imexportResize + object btn_export: TButton + Left = 4 + Top = 4 + Width = 142 + Height = 25 + Caption = '&Export to file...' + TabOrder = 0 + OnClick = btn_exportClick + end + object btn_import: TButton + Left = 4 + Top = 32 + Width = 142 + Height = 25 + Caption = '&Import from file...' + TabOrder = 1 + OnClick = btn_importClick + end + end + end + object opend: TOpenDialog + Options = [ofPathMustExist, ofFileMustExist, ofEnableSizing] + Left = 120 + Top = 392 + end + object saved: TSaveDialog + Options = [ofOverwritePrompt, ofPathMustExist, ofEnableSizing] + Left = 120 + Top = 368 + end +end Index: /oup/releases/0.21a/Unit8_binedit.pas =================================================================== --- /oup/releases/0.21a/Unit8_binedit.pas (revision 21) +++ /oup/releases/0.21a/Unit8_binedit.pas (revision 21) @@ -0,0 +1,410 @@ +UNIT Unit8_binedit; +INTERFACE +USES + Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, + Dialogs, Wrapgrid, StdCtrls, Grids, StrUtils, MPHexEditor, ExtCtrls, + Unit3_data, Unit2_functions, Unit9_data_structures, Unit4_exporters; + +TYPE + TForm8 = Class(TForm) + Splitter1: TSplitter; + panel_data: TPanel; + hex: TMPHexEditor; + Splitter2: TSplitter; + structs: TWrapGrid; + panel_files: TPanel; + list: TListBox; + panel_extension: TPanel; + lbl_filter: TLabel; + combo_extension: TComboBox; + Bevel1: TBevel; + panel_imexport: TPanel; + btn_export: TButton; + btn_import: TButton; + opend: TOpenDialog; + saved: TSaveDialog; +{ PROCEDURE structsGetEditText(Sender: TObject; ACol, ARow: Integer; var Value: string); + PROCEDURE structsSetEditText(Sender: TObject; ACol, ARow: Integer; const Value: string); + PROCEDURE structsKeyPress(Sender: TObject; var Key: Char); +} PROCEDURE FormActivate(Sender: TObject); + PROCEDURE btn_importClick(Sender: TObject); + PROCEDURE btn_exportClick(Sender: TObject); + PROCEDURE panel_imexportResize(Sender: TObject); + FUNCTION Save:Boolean; + PROCEDURE FormClose(Sender: TObject; var Action: TCloseAction); + PROCEDURE combo_extensionClick(Sender: TObject); + PROCEDURE panel_extensionResize(Sender: TObject); + FUNCTION GetValue(datatype:Word; offset:LongWord):String; + PROCEDURE WriteStructureInfos(structinfoid:Integer); + PROCEDURE hexSelectionChanged(Sender: TObject); + PROCEDURE hexChange(Sender: TObject); + PROCEDURE panel_dataResize(Sender: TObject); + PROCEDURE structsClick(Sender: TObject); + PROCEDURE FormResize(Sender: TObject); + PROCEDURE ClearStructViewer; + PROCEDURE listClick(Sender: TObject); + PROCEDURE FormCloseQuery(Sender: TObject; var CanClose: Boolean); + PROCEDURE FormCreate(Sender: TObject); + PROCEDURE Recreatelist; + PRIVATE + PUBLIC + END; + +VAR + Form8: TForm8; + +IMPLEMENTATION +{$R *.dfm} +USES Unit1_main; +VAR + fileid:LongWord; + +FUNCTION IntToBin(value:Byte):String; + VAR i:Byte; + BEGIN + Result:=''; + FOR i:=7 DOWNTO 0 DO BEGIN + Result:=Result+IntToStr((value SHR i) AND $01); + END; + END; + +FUNCTION TForm8.GetValue(datatype:Word; offset:LongWord):String; + VAR + data:Tdata; + i:Word; + BEGIN + CASE datatype OF + 1: Result:=IntToStr(hex.data[offset]); + 2: Result:=IntToStr(hex.data[offset]+hex.data[offset+1]*256); + 3: Result:=IntToStr(hex.data[offset]+hex.data[offset+1]*256+hex.data[offset+2]*256*256); + 4: Result:=IntToStr(hex.data[offset]+hex.data[offset+1]*256+hex.data[offset+2]*256*256+hex.data[offset+3]*256*256*256); + 5: Result:='0x'+IntToHex(hex.data[offset],2); + 6: Result:='0x'+IntToHex(hex.data[offset]+hex.data[offset+1]*256,4); + 7: Result:='0x'+IntToHex(hex.data[offset]+hex.data[offset+1]*256+hex.data[offset+2]*256*256,6); + 8: Result:='0x'+IntToHex(hex.data[offset]+hex.data[offset+1]*256+hex.data[offset+2]*256*256+hex.data[offset+3]*256*256*256,8); + 9: BEGIN + SetLength(data,4); + data[0]:=hex.data[offset]; + data[1]:=hex.data[offset+1]; + data[2]:=hex.data[offset+2]; + data[3]:=hex.data[offset+3]; + Result:=FloatToStr(Decode_Float(data)); + END; + 10: Result:=IntToBin(hex.data[offset]); + 10000..65535: BEGIN + Result:=''; + FOR i:=1 TO datatype-10000 DO BEGIN + IF hex.Data[offset+i-1]>=32 THEN + Result:=Result+Chr(hex.Data[offset+i-1]) + ELSE + Result:=Result+'.'; + END; + END; + END; + END; + +PROCEDURE TForm8.WriteStructureInfos(structinfoid:Integer); + VAR + i:Byte; + BEGIN + IF structinfoid>=0 THEN BEGIN + structs.Enabled:=True; + WITH structure_infos[structinfoid] DO BEGIN + Self.structs.RowCount:=Length(entries)+1; + FOR i:=1 TO Length(entries) DO BEGIN + Self.structs.Cells[0,i]:=entries[i-1].name; + Self.structs.Cells[1,i]:='0x'+IntToHex(entries[i-1].offset,6); + Self.structs.Cells[2,i]:=GetDataType(entries[i-1].datatype); + IF entries[i-1].datatype>10000 THEN + Self.structs.Cells[3,i]:='*String*#HINT:'+GetValue(entries[i-1].datatype,entries[i-1].offset)+'#' + ELSE + Self.structs.Cells[3,i]:=GetValue(entries[i-1].datatype,entries[i-1].offset); + Self.structs.Cells[4,i]:=entries[i-1].description; + END; + END; + END; + END; + +PROCEDURE TForm8.Recreatelist; + VAR + i:LongWord; + exts:TStringList; + BEGIN + combo_extension.Items.Clear; + combo_extension.Items.Add('_All files_ ('{+IntToStr(dat_header.Files)}+')'); + exts:=GetExtensionsList; + FOR i:=0 TO High(exts) DO + combo_extension.Items.Add(exts[i]); + combo_extension.ItemIndex:=0; + combo_extensionClick(Self); + END; + +PROCEDURE TForm8.FormCreate(Sender: TObject); + BEGIN + Self.Caption:=''; + fileid:=0; + structs.ColCount:=5; + structs.RowCount:=2; + structs.FixedRows:=1; + structs.Cells[0,0]:='Name'; + structs.Cells[1,0]:='Offset'; + structs.Cells[2,0]:='Type'; + structs.Cells[3,0]:='Value'; + structs.Cells[4,0]:='Description'; + structs.ColWidths[0]:=75; + structs.ColWidths[1]:=60; + structs.ColWidths[2]:=75; + structs.ColWidths[3]:=75; + Self.panel_dataResize(Self); + END; + +FUNCTION TForm8.Save:Boolean; + VAR + mem:TMemoryStream; + data:Tdata; + BEGIN + CASE MessageBox(Self.Handle,PChar('Save changes to file '+dat_files[fileid].FileName+'?'),PChar('Data changed...'),MB_YESNOCANCEL) OF + IDYES: BEGIN + mem:=TMemoryStream.Create; + hex.SaveToStream(mem); + mem.Seek(0,soFromBeginning); + SetLength(data,mem.Size); + mem.Read(data[0],mem.Size); + mem.Free; + UpdateDatFile(fileid,data); + Result:=True; + END; + IDNO: Result:=True; + IDCANCEL: BEGIN + Result:=False; + END; + END; + END; + +PROCEDURE TForm8.FormCloseQuery(Sender: TObject; var CanClose: Boolean); + BEGIN + IF hex.Modified THEN BEGIN + IF NOT Save THEN CanClose:=False; + END; + END; + +PROCEDURE TForm8.listClick(Sender: TObject); + VAR + mem:TMemoryStream; + data:Tdata; + i:LongWord; + BEGIN + IF hex.Modified THEN BEGIN + IF NOT Save THEN BEGIN + FOR i:=0 TO list.Count-1 DO BEGIN + IF StrToInt(MidStr(list.Items.Strings[i],1,5))=fileid THEN BEGIN + list.ItemIndex:=i; + Exit; + END; + END; + END; + END; + Self.ClearStructViewer; + fileid:=StrToInt(MidStr(list.Items.Strings[list.ItemIndex],1,5)); + data:=LoadDatFile(fileid); + IF Length(data)>0 THEN BEGIN + mem:=TMemoryStream.Create; + mem.Write(data[0],Length(data)); + mem.Seek(0,soFromBeginning); + hex.LoadFromStream(mem); + mem.Free; + WriteStructureInfos(GetStructureInfoId(dat_files[fileid].Extension)); + END; + END; + +PROCEDURE TForm8.ClearStructViewer; + VAR + x:Word; + BEGIN + structs.RowCount:=2; + FOR x:=0 TO structs.ColCount-1 DO structs.Cells[x,1]:=''; + structs.Enabled:=False; + END; + +PROCEDURE TForm8.FormResize(Sender: TObject); + BEGIN + IF Self.Width>=650 THEN BEGIN + END ELSE Self.Width:=650; + IF Self.Height>=450 THEN BEGIN + END ELSE Self.Height:=450; + END; + +PROCEDURE TForm8.structsClick(Sender: TObject); + VAR + offset:LongWord; + length:Byte; + BEGIN + IF structs.Row>0 THEN BEGIN + offset:=structure_infos[GetStructureInfoId(dat_files[fileid].extension)].entries[structs.Row-1].offset; + length:=GetTypeDataLength(structure_infos[GetStructureInfoId(dat_files[fileid].extension)].entries[structs.Row-1].datatype); + hex.SelStart:=offset; + hex.SelEnd:=offset+length-1; +{ IF structs.Cells[structs.Col,0]='Value' THEN + IF structure_infos[GetStructureInfoId(dat_files[fileid].Extension)].entries[structs.Row-1].datatype<=10 THEN + structs.Options:=structs.Options+[goEditing] + ELSE + structs.Options:=structs.Options-[goEditing]; +} END; + END; + +PROCEDURE TForm8.panel_dataResize(Sender: TObject); + BEGIN + structs.ColWidths[4]:=structs.Width-structs.ColWidths[0]-structs.ColWidths[1]-structs.ColWidths[2]-structs.ColWidths[3]-28; + END; + +PROCEDURE TForm8.hexChange(Sender: TObject); + BEGIN + IF hex.DataSize>0 THEN + WriteStructureInfos(GetStructureInfoId(dat_files[fileid].Extension)); + END; + +PROCEDURE TForm8.hexSelectionChanged(Sender: TObject); + VAR + selstart:Integer; + i,j:Word; + BEGIN + FOR i:=1 TO structs.RowCount-1 DO BEGIN + FOR j:=0 TO structs.ColCount-1 DO BEGIN + structs.CellColors[j,i]:=clWhite; + structs.CellFontColors[j,i]:=clBlack; + END; + END; + IF hex.DataSize>0 THEN BEGIN + selstart:=hex.SelStart; + IF GetStructureInfoId(dat_files[fileid].Extension)>=0 THEN BEGIN + WITH structure_infos[GetStructureInfoId(dat_files[fileid].Extension)] DO BEGIN + FOR i:=0 TO High(entries) DO BEGIN + IF ((selstart-entries[i].offset)=0) THEN BEGIN + FOR j:=0 TO structs.ColCount-1 DO BEGIN + structs.CellColors[j,i+1]:=clBlue; + structs.CellFontColors[j,i+1]:=clWhite; + END; + structs.Row:=i+1; + END; + END; + END; + END; + END; + END; + +PROCEDURE TForm8.panel_extensionResize(Sender: TObject); + BEGIN + combo_extension.Width:=panel_extension.Width-5; + END; + +PROCEDURE TForm8.combo_extensionClick(Sender: TObject); + VAR + Extension:String[4]; + files:TStringList; + i:LongWord; + BEGIN + Extension:=MidStr(combo_extension.Items.Strings[combo_extension.ItemIndex],1,4); + list.Items.Clear; + IF Extension='_All' THEN + files:=GetFilesList('','',True) + ELSE + files:=GetFilesList(extension,'',True); + IF Length(files)>0 THEN + FOR i:=0 TO High(files) DO + list.Items.Add(files[i]); + END; + +PROCEDURE TForm8.FormClose(Sender: TObject; var Action: TCloseAction); + BEGIN + Action:=caFree; + Form1.close_window(Self.Name); + END; + +PROCEDURE TForm8.panel_imexportResize(Sender: TObject); + BEGIN + btn_import.Width:=panel_imexport.Width-8; + btn_export.Width:=panel_imexport.Width-8; + END; + +PROCEDURE TForm8.btn_exportClick(Sender: TObject); + BEGIN + saved.Filter:='Files of matching extension (*.'+dat_files[fileid].Extension+')|*.'+dat_files[fileid].Extension+'|All files|*.*'; + saved.DefaultExt:=dat_files[fileid].Extension; + IF saved.Execute THEN BEGIN + ExportDatFile(fileid,saved.FileName); + END; + END; + +PROCEDURE TForm8.btn_importClick(Sender: TObject); + VAR + data:Tdata; + fs:TFileStream; + BEGIN + opend.Filter:='Files of matching extension (*.'+dat_files[fileid].Extension+')|*.'+dat_files[fileid].Extension+'|All files|*.*'; + IF opend.Execute THEN BEGIN + fs:=TFileStream.Create(opend.FileName,fmOpenRead); + IF fs.Size<>dat_files[fileid].size THEN BEGIN + ShowMessage('Can''t import '+ExtractFilename(opend.FileName)+ + ', file has to have same size as file in .dat.'+CrLf+ + 'Size of file in .dat: '+FormatFileSize(dat_files[fileid].size)+CrLf+ + 'Size of chosen file: '+FormatFileSize(fs.Size)); + END ELSE BEGIN + SetLength(data,fs.Size); + fs.Read(data[0],fs.Size); + fs.Free; + fs:=TFileStream.Create(dat_filename,fmOpenReadWrite); + fs.Seek(dat_files[fileid].dataddr,soFromBeginning); + fs.Write(data[0],Length(data)); + END; + fs.Free; + listClick(Self); + END; + END; + +PROCEDURE TForm8.FormActivate(Sender: TObject); + BEGIN + Form1.SetActiveWindow(Self.Name); + END; +{ +PROCEDURE TForm8.structsKeyPress(Sender: TObject; VAR Key: Char); + VAR + dt:Byte; + BEGIN + IF structs.EditorMode THEN BEGIN + dt:=structure_infos[GetStructureInfoId(dat_files[fileid].Extension)].entries[structs.Row-1].datatype; + CASE dt OF + 1..4: BEGIN + IF NOT (Key IN [#8,#13,#27,'0'..'9']) THEN Key:=#0; + END; + 5..8: BEGIN + IF NOT (Key IN [#8,#13,#27,'0'..'9','A'..'F','a'..'f']) THEN Key:=#0; + IF Key IN ['a'..'f'] THEN Key:=UpCase(Key); + IF NOT (Key IN [#8,#13,#27]) AND ( Length(structs.Cells[structs.Col,structs.Row])>=2*(dt-4) ) THEN Key:=#0; + END; + 9: BEGIN + IF (Key IN ['.']) AND (Pos('.',structs.Cells[structs.Col,structs.Row])>0) THEN Key:=#0; + IF NOT (Key IN [#8,#13,#27,'0'..'9','.','-']) THEN Key:=#0; + END; + 10: BEGIN + IF NOT (Key IN [#8,#13,#27,'0'..'1']) THEN Key:=#0; + IF NOT (Key IN [#8,#13,#27]) AND ( Length(structs.Cells[structs.Col,structs.Row])>=8 ) THEN Key:=#0; + END; + END; + END; + END; + +PROCEDURE TForm8.structsSetEditText(Sender: TObject; ACol, ARow: Integer; CONST Value: string); + BEGIN + IF NOT TWrapGrid(Sender).EditorMode THEN + ShowMessage('['+IntToStr(ACol)+'|'+IntToStr(ARow)+']='+Value); + END; + +PROCEDURE TForm8.structsGetEditText(Sender: TObject; ACol, ARow: Integer; var Value: string); + BEGIN + IF structs.EditorMode THEN + ShowMessage('EditorMode - '+Value) + ELSE + ShowMessage('NOT EditorMode - '+Value); + END; +} +END. Index: /oup/releases/0.21a/Unit9_data_structures.pas =================================================================== --- /oup/releases/0.21a/Unit9_data_structures.pas (revision 21) +++ /oup/releases/0.21a/Unit9_data_structures.pas (revision 21) @@ -0,0 +1,113 @@ +UNIT Unit9_data_structures; +INTERFACE +USES SysUtils; + +TYPE + Tstructure_entry=RECORD + name:String; + offset:LongWord; + datatype:Word; // 1..4: Integer[1..4] dec; 5..8: Integer[1..4] hex; 9: float; 10: bitset; 10000+: string[0+] + description:String; + END; + Tstructure_info=RECORD + extension:String; + typedesc:String; + entries:Array OF Tstructure_entry; + END; + Tstructures=Array OF Tstructure_info; + +VAR + structure_infos:Tstructures; + + +FUNCTION GetDataType(typeid:Word):String; +FUNCTION GetStructureInfoId(ext:String):Integer; +FUNCTION GetTypeDataLength(datatype:Word):Word; + + + +IMPLEMENTATION + +FUNCTION GetTypeDataLength(datatype:Word):Word; + BEGIN + CASE datatype OF + 1..4: Result:=datatype; + 5..8: Result:=datatype-4; + 9: Result:=4; + 10: Result:=1; + 10000..65535: Result:=datatype-10000; + END; + END; + + +FUNCTION GetStructureInfoId(ext:String):Integer; + VAR + i:Integer; + BEGIN + FOR i:=0 TO High(structure_infos) DO BEGIN + IF structure_infos[i].extension=ext THEN BEGIN + Result:=i; + Exit; + END; + END; + Result:=-1; + END; + + +FUNCTION GetDataType(typeid:Word):String; + BEGIN + CASE typeid OF + 1..4: Result:='Int'+IntToStr(typeid*8); + 5..8: Result:='Int'+IntToStr((typeid-4)*8); + 9: Result:='Float'; + 10: Result:='BitSet'; + 10000..65535: Result:='String('+IntToStr(typeid-10000)+')'; + END; + END; + + +PROCEDURE AddEntry(_ext:String; _name:String; _offset:LongWord; _datatype:Word; _description:String); + VAR + sid:Integer; + BEGIN + sid:=GetStructureInfoId(_ext); + IF sid>=0 THEN BEGIN + WITH structure_infos[sid] DO BEGIN + SetLength(entries,Length(entries)+1); + WITH entries[High(entries)] DO BEGIN + name:=_name; + offset:=_offset; + datatype:=_datatype; + description:=_description; + END; + END; + END; + END; + + +PROCEDURE AddExtension(_ext:String; _typedesc:String); + BEGIN + IF GetStructureInfoId(_ext)<0 THEN BEGIN + SetLength(structure_infos,Length(structure_infos)+1); + WITH structure_infos[High(structure_infos)] DO BEGIN + extension:=_ext; + typedesc:=_typedesc; + END; + END; + END; + + +BEGIN + AddExtension('TXMP','Texture'); + AddEntry('TXMP','ID',$00,4,'ID of this file'); + AddEntry('TXMP','LevelID',$04,8,'ID of the level this file is in'); + AddEntry('TXMP','FileName',$08,10128,''); + AddEntry('TXMP','Fading',$88,10,'Fading-Bitset'); + AddEntry('TXMP','Depth',$89,10,'Depth-Bitset'); + AddEntry('TXMP','Width',$8C,2,'x-resolution of image'); + AddEntry('TXMP','Height',$8E,2,'y-resolution of image'); + AddEntry('TXMP','Storetype',$90,10,'Storetype-Bitset'); + AddEntry('TXMP','TXAN-Link',$94,8,'Link to the TXAN-file (if this TXMP is the first image of an animation)'); + AddEntry('TXMP','TXMP-Link',$98,8,'Link to another TXMP-file'); + AddEntry('TXMP','Raw-Link',$9C,8,'Address of the image data in the .raw-file'); +END.