Index: p/releases/0.29a2/src/OniUnPacker.bdsproj =================================================================== --- /oup/releases/0.29a2/src/OniUnPacker.bdsproj (revision 28) +++ (revision ) @@ -1,184 +1,0 @@ - - - - - - - - - - - - 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 - True - True - - - - 0 - 0 - 1 - False - False - False - 16384 - 1048576 - 4194304 - - False - - - exe - dcu - - - - 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 - - True - False - - - False - False - 1 - 0 - 0 - 0 - False - False - False - False - False - 1031 - 1252 - - - - - 1.0.0.0 - - - - - - 1.0.0.0 - - - - - $00000000 - - - - (untitled) - Borland Web Wizard Package - - - Index: p/releases/0.29a2/src/Unit10_leveldb.dfm =================================================================== --- /oup/releases/0.29a2/src/Unit10_leveldb.dfm (revision 28) +++ (revision ) @@ -1,61 +1,0 @@ -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: p/releases/0.29a2/src/Unit10_leveldb.pas =================================================================== --- /oup/releases/0.29a2/src/Unit10_leveldb.pas (revision 28) +++ (revision ) @@ -1,952 +1,0 @@ -UNIT Unit10_leveldb; -INTERFACE -USES - Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, - Dialogs, ComCtrls, StdCtrls, StrUtils; - -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(source,target:String); - PROCEDURE CreateLevel(source,target:String); - END; - - -VAR - Form10: TForm10; - -IMPLEMENTATION -{$R *.dfm} -USES ABSMain, ABSDecUtil, Unit1_main, Unit2_functions, Unit3_data, Unit9_data_structures; -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:TMemoryStream; - raw_stream:TMemoryStream; - mem:TMemoryStream; - DataBase:TABSDatabase; - Query:TABSQuery; - MimeCoder: TStringFormat_MIME64; - -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.CreateLevel(source,target:String); - VAR - i:LongWord; - BEGIN - END; - -PROCEDURE TForm10.CreateDatabase(source,target:String); - VAR - i,j:LongWord; - temps,temps2:String; - data:Tdata; - absolutebegintime,begintime:Double; - step:Byte; - rawlist:TRawList; - 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:=target; - btn_abortok.Caption:='&Abort...'; - btn_abortok.Default:=False; - - absolutebegintime:=Time; - - DataBase:=TABSDatabase.Create(Self); - DataBase.DatabaseName:='OLDB'; - DataBase.DatabaseFileName:=loaded_filename; - DataBase.CreateDatabase; - - DoStep('Creating tables'); - progress.Position:=0; - lbl_progress.Caption:=''; - lbl_estimation.Caption:='Estimated finishing time: unknown'; - Application.ProcessMessages; - - Query:=TABSQuery.Create(Self); - Query.DatabaseName:='OLDB'; - Query.SQL.Text:='CREATE TABLE globals ( id AUTOINC PRIMARY KEY, name STRING(128), value STRING(128) );'; - Query.ExecSQL; - Query.SQL.Text:='CREATE TABLE linkmap ( id AUTOINC PRIMARY KEY, src_id INTEGER, src_link_offset INTEGER, target_id INTEGER );'; - Query.ExecSQL; - Query.SQL.Text:='CREATE TABLE rawmap ( id AUTOINC PRIMARY KEY, src_id INTEGER, src_link_offset INTEGER, size INTEGER, data BLOB BlobCompressionMode 9 BlobBlockSize 1024 BlobCompressionAlgorithm ZLib );'; -// Query.SQL.Text:='CREATE TABLE rawmap ( id AUTOINC PRIMARY KEY, src_id INTEGER, src_link_offset INTEGER, size INTEGER, data BLOB BlobCompressionAlgorithm None );'; - Query.ExecSQL; - Query.SQL.Text:='CREATE TABLE datfiles ( id INTEGER PRIMARY KEY, extension CHAR(4), name STRING(128), contenttype INTEGER, size INTEGER, data BLOB BlobCompressionMode 9 BlobBlockSize 1024 BlobCompressionAlgorithm ZLib );'; -// Query.SQL.Text:='CREATE TABLE datfiles ( id INTEGER PRIMARY KEY, extension CHAR(4), name STRING(128), contenttype INTEGER, size INTEGER, data BLOB BlobCompressionAlgorithm None );'; - Query.ExecSQL; - Query.SQL.Text:='CREATE TABLE extlist ( id AUTOINC PRIMARY KEY, ext CHAR(4), ident CHAR(16) );'; - Query.ExecSQL; - - Query.SQL.Text:='INSERT INTO globals (name,value) VALUES ("dbversion","'+dbversion+'");'; - Query.ExecSQL; - 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); - Query.SQL.Text:='INSERT INTO globals (name,value) VALUES ("ident","'+temps+'");'; - Query.ExecSQL; - data:=LoadDatFile(0); - i:=data[7]; - i:=i DIV 2; - Query.SQL.Text:='INSERT INTO globals (name,value) VALUES ("lvl","'+IntToStr(i)+'");'; - Query.ExecSQL; - - 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]; - Query.SQL.Text:='INSERT INTO extlist (ext,ident) VALUES ("'+temps2+'","'+temps+'");'; - Query.ExecSQL; - 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:=''; - - progress.Position:=0; - lbl_progress.Caption:='Files done: '+IntToStr(0)+'/'+IntToStr(dat_header.Files); - lbl_estimation.Caption:='Estimated finishing time: unknown'; - - DoStep('Loading .dat into memory'); - Application.ProcessMessages; - - 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; - - Database.StartTransaction; - FOR i:=0 TO dat_header.Files-1 DO BEGIN - IF (dat_files[i].FileType AND $02)=0 THEN BEGIN - dat_stream.Seek(dat_files[i].DatAddr,soFromBeginning); - mimecoder:=TStringFormat_MIME64.Create; - mem:=TMemoryStream.Create; - mem.CopyFrom(dat_stream,dat_files[i].Size); - Query.SQL.Text:='INSERT INTO datfiles (id,extension,name,contenttype,size,data) VALUES ('+IntToStr(i)+',"'+dat_files[i].Extension+'","'+dat_files[i].Name+'","'+IntToHex(dat_files[i].FileType,8)+'",'+IntToStr(dat_files[i].size)+',MimeToBin("'+MimeCoder.StrTo(mem.Memory, mem.Size)+'") );'; - Query.ExecSQL; - mem.Free; - mimecoder.Free; - - rawlist:=GetRawList(i); - IF Length(rawlist)>0 THEN BEGIN - FOR j:=0 TO High(rawlist) DO BEGIN - IF rawlist[j].raw_size>0 THEN BEGIN - mem:=TMemoryStream.Create; - filestream:=TFileStream.Create(raw_filename,fmOpenRead); - filestream.Seek(rawlist[j].raw_addr,soFromBeginning); - mem.CopyFrom(filestream,rawlist[j].raw_size); - filestream.Free; - mimecoder:=TStringFormat_MIME64.Create; - Query.SQL.Text:='INSERT INTO rawmap (src_id,src_link_offset,size,data) VALUES ('+IntToStr(i)+','+IntToStr(rawlist[j].src_offset)+','+IntToStr(rawlist[j].raw_size)+',MimeToBin("'+MimeCoder.StrTo(mem.Memory, mem.Size)+'") );'; - Query.ExecSQL; - mem.Free; - mimecoder.Free; - END ELSE BEGIN - Query.SQL.Text:='INSERT INTO rawmap (src_id,src_link_offset,size) VALUES ('+IntToStr(i)+','+IntToStr(rawlist[j].src_offset)+',0);'; - Query.ExecSQL; - END; - END; - END; - - HandleFile(dat_files[i].Extension,i,True); - END ELSE BEGIN - Query.SQL.Text:='INSERT INTO datfiles (id,extension,name,contenttype,size) VALUES ('+IntToStr(i)+',"'+dat_files[i].Extension+'","'+dat_files[i].Name+'","'+IntToHex(dat_files[i].FileType,8)+'",0);'; - Query.ExecSQL; - END; - IF ( (i MOD 100)=0 ) AND (i>0) THEN BEGIN - Database.Commit(False); - Database.StartTransaction; - END; - IF ( (i MOD 25)=0 ) AND (i>=100) THEN - lbl_estimation.Caption:='Estimated finishing time: '+TimeToStr((Time-begintime)/i*dat_header.Files+begintime); - progress.Position:=i; - lbl_progress.Caption:='Files done: '+IntToStr(i)+'/'+IntToStr(dat_header.Files); - Application.ProcessMessages; - IF abort THEN BEGIN - stop_convert; - Exit; - END; - END; - Database.Commit(False); - 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; - - database.Close; - database.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)'; - DataBase.Close; - IF MessageBox(Self.Handle, PChar('Delete the unfinished DB-file?'), PChar('Delete file?'), MB_YESNO)=IDYES THEN BEGIN - 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(fileid,offset,size:LongWord; target:Pointer); - BEGIN - dat_stream.Seek(dat_files[fileid].DatAddr+offset,soFromBeginning); - dat_stream.Read(target^,size); - END; - -PROCEDURE InsertDatLinkToDB(fileid:LongWord; offset:LongWord); - VAR - link:LongWord; - BEGIN - LoadFilePart(fileid,offset,4,@link); - IF link=0 THEN - link:=$FFFFFFFF - ELSE - link:=link DIV 256; - Query.SQL.Text:='INSERT INTO linkmap (src_id,src_link_offset,target_id) VALUES ('+IntToStr(fileid)+','+IntToStr(offset)+','+IntToStr(link)+');'; - Query.ExecSQL; - END; -(* -PROCEDURE InsertRawFileToDB(fileid:LongWord; src_offset,raw_addr,size:LongWord); - VAR - localmem:TMemoryStream; -// temps:String; - BEGIN - IF size>0 THEN BEGIN - localmem:=TMemoryStream.Create; - filestream:=TFileStream.Create(raw_filename,fmOpenRead); - filestream.Seek(raw_addr,soFromBeginning); - localmem.CopyFrom(filestream,size); - filestream.Free; - mimecoder:=TStringFormat_MIME64.Create; - Query.SQL.Text:='INSERT INTO rawmap (src_id,src_link_offset,size,data) VALUES ('+IntToStr(fileid)+','+IntToStr(src_offset)+','+IntToStr(size)+',MimeToBin("'+MimeCoder.StrTo(localmem.Memory, localmem.Size)+'") );'; - Query.ExecSQL; - localmem.Free; - mimecoder.Free; - END ELSE BEGIN - Query.SQL.Text:='INSERT INTO rawmap (src_id,src_link_offset,size) VALUES ('+IntToStr(fileid)+','+IntToStr(src_offset)+',0);'; - Query.ExecSQL; - END; -{ IF (raw_addr MOD 32)>0 THEN BEGIN - temps:='FileID='+FormatNumber(fileid,5,'0')+' - dat-Offset=0x'+IntToHex(src_offset,8)+' - raw-address=0x'+IntToHex(raw_addr,8)+#13+#10; - filestream:=TFileStream.Create('D:\not32.txt',fmOpenReadWrite); - filestream.Seek(0,soFromEnd); - filestream.Write(temps[1],Length(temps)); - filestream.Free; - 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 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(fileid,$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(fileid,$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(fileid,$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(fileid,$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(fileid,$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(fileid,$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(fileid,$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(fileid,$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 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(fileid,$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 STNA(fileid:LongWord; dir_dat2db:Boolean); - VAR - packages:Word; - i:LongWord; - BEGIN - IF dir_dat2db THEN BEGIN - LoadFilePart(fileid,$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(fileid,$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); - BEGIN - IF dir_dat2db THEN BEGIN - InsertDatLinkToDB(fileid,$40); - InsertDatLinkToDB(fileid,$44); - 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(fileid,$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(fileid,$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(fileid,$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(fileid,$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(fileid,$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(fileid,$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(fileid,$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); - BEGIN - IF dir_dat2db THEN BEGIN - 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(fileid,$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',False,NIL); - 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',False,NIL); - 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',False,NIL); - InsertHandler('STNA',True,STNA); - InsertHandler('SUBT',False,NIL); - 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: p/releases/0.29a2/src/Unit11_extractor.dfm =================================================================== --- /oup/releases/0.29a2/src/Unit11_extractor.dfm (revision 28) +++ (revision ) @@ -1,258 +1,0 @@ -object Form11: TForm11 - Left = 0 - Top = 0 - Caption = 'Extractor' - ClientHeight = 398 - ClientWidth = 487 - 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 = 293 - Width = 187 - Height = 103 - Align = alBottom - BevelOuter = bvNone - TabOrder = 0 - OnResize = panel_extensionResize - object lbl_filter: TLabel - Left = 2 - Top = 62 - Width = 100 - Height = 17 - AutoSize = False - Caption = 'Filter by &extension:' - FocusControl = combo_extension - end - object combo_extension: TComboBox - Left = 2 - Top = 76 - 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 = 3 - OnClick = combo_extensionClick - end - object check_zerobyte: TCheckBox - Left = 2 - Top = 44 - Width = 130 - Height = 13 - Caption = 'Show &zero-byte files' - TabOrder = 2 - OnClick = check_zerobyteClick - end - object edit_filtername: TEdit - Left = 2 - Top = 20 - Width = 145 - Height = 18 - AutoSize = False - TabOrder = 1 - end - object check_filtername: TCheckBox - Left = 2 - Top = 5 - Width = 130 - Height = 15 - Caption = 'Filter by file&name:' - TabOrder = 0 - OnClick = check_filternameClick - end - end - object list: TListBox - Left = 2 - Top = 15 - Width = 187 - Height = 278 - Align = alClient - ItemHeight = 13 - MultiSelect = True - TabOrder = 1 - 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: p/releases/0.29a2/src/Unit11_extractor.pas =================================================================== --- /oup/releases/0.29a2/src/Unit11_extractor.pas (revision 28) +++ (revision ) @@ -1,242 +1,0 @@ -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; - 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; - panel_extension: TPanel; - lbl_filter: TLabel; - combo_extension: TComboBox; - check_zerobyte: TCheckBox; - edit_filtername: TEdit; - check_filtername: TCheckBox; - list: TListBox; - PROCEDURE LoadFileNames; - PROCEDURE check_filternameClick(Sender: TObject); - PROCEDURE check_zerobyteClick(Sender: TObject); - PROCEDURE combo_extensionClick(Sender: TObject); - PROCEDURE panel_extensionResize(Sender: TObject); - PROCEDURE Recreatelist; - - PROCEDURE FormCreate(Sender: TObject); - PROCEDURE FormActivate(Sender: TObject); - PROCEDURE FormClose(Sender: TObject; var Action: TCloseAction); - PROCEDURE FormResize(Sender: TObject); - PROCEDURE Extract(Sender: TObject); - PRIVATE - PUBLIC - 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(GetFilesCount)+')'); - 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.LoadFileNames; - VAR - Extension:String[4]; - no_zero_bytes:Boolean; - pattern:String; - files:TStringList; - i:LongWord; - BEGIN - Extension:=MidStr(combo_extension.Items.Strings[combo_extension.ItemIndex],1,4); - no_zero_bytes:=NOT check_zerobyte.Checked; - pattern:=''; - IF check_filtername.Checked THEN pattern:=edit_filtername.Text; - IF Extension='_All' THEN Extension:=''; - - files:=GetFilesList(extension,pattern,no_zero_bytes); - list.Items.Clear; - IF Length(files)>0 THEN - FOR i:=0 TO High(files) DO - list.Items.Add(files[i]); - END; - -PROCEDURE TForm11.panel_extensionResize(Sender: TObject); - BEGIN - combo_extension.Width:=panel_extension.Width-5; - edit_filtername.Width:=panel_extension.Width-5; - END; - -PROCEDURE TForm11.combo_extensionClick(Sender: TObject); - BEGIN - LoadFileNames; - END; - -PROCEDURE TForm11.check_zerobyteClick(Sender: TObject); - VAR - i:Byte; - BEGIN - LoadFileNames; - END; - -PROCEDURE TForm11.check_filternameClick(Sender: TObject); - BEGIN - edit_filtername.Enabled:=NOT check_filtername.Checked; - LoadFileNames; - 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(GetFileIDByName(list.Items.Strings[list.ItemIndex]),ExtractFileName(saved.FileName),settings,ExtractFileDir(saved.FileName)); - END ELSE BEGIN - ExportFile(GetFileIDByName(list.Items.Strings[list.ItemIndex]),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(GetFileIDByName(list.Items.Strings[list.ItemIndex]),ExtractFileName(saved.FileName),settings,ExtractFileDir(saved.FileName)); - END ELSE BEGIN - ExportFile(GetFileIDByName(list.Items.Strings[list.ItemIndex]),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: p/releases/0.29a2/src/Unit12_ValueEdit.dfm =================================================================== --- /oup/releases/0.29a2/src/Unit12_ValueEdit.dfm (revision 28) +++ (revision ) @@ -1,157 +1,0 @@ -object Form12: TForm12 - Left = 0 - Top = 0 - BorderStyle = bsNone - BorderWidth = 1 - Caption = 'Value Edit' - ClientHeight = 145 - ClientWidth = 298 - Color = clBtnFace - Constraints.MaxHeight = 147 - Constraints.MaxWidth = 700 - Constraints.MinHeight = 147 - Constraints.MinWidth = 300 - Font.Charset = DEFAULT_CHARSET - Font.Color = clWindowText - Font.Height = -11 - Font.Name = 'Tahoma' - Font.Style = [] - OldCreateOrder = False - Position = poMainFormCenter - PixelsPerInch = 96 - TextHeight = 13 - object group: TGroupBox - Left = 0 - Top = 0 - Width = 298 - Height = 145 - Align = alClient - Caption = '---' - TabOrder = 0 - DesignSize = ( - 298 - 145) - object lbl_current: TLabel - Left = 8 - Top = 64 - Width = 73 - Height = 17 - AutoSize = False - Caption = 'Current value:' - end - object lbl_new: TLabel - Left = 8 - Top = 88 - Width = 73 - Height = 17 - AutoSize = False - Caption = 'New value:' - end - object lbl_offset: TLabel - Left = 8 - Top = 16 - Width = 73 - Height = 17 - AutoSize = False - Caption = 'Offset:' - end - object lbl_datatype: TLabel - Left = 8 - Top = 40 - Width = 73 - Height = 17 - AutoSize = False - Caption = 'Datatype:' - end - object btn_ok: TButton - Left = 153 - Top = 112 - Width = 65 - Height = 25 - Anchors = [akTop, akRight] - Caption = 'OK' - Default = True - TabOrder = 0 - OnClick = btn_okClick - end - object btn_cancel: TButton - Left = 225 - Top = 112 - Width = 65 - Height = 25 - Anchors = [akTop, akRight] - Cancel = True - Caption = 'Cancel' - TabOrder = 1 - OnClick = btn_cancelClick - end - object edit_current: TEdit - Left = 88 - Top = 64 - Width = 203 - Height = 18 - Anchors = [akLeft, akTop, akRight] - AutoSize = False - Color = clInfoBk - ReadOnly = True - TabOrder = 2 - end - object edit_offset: TEdit - Left = 87 - Top = 16 - Width = 203 - Height = 18 - Anchors = [akLeft, akTop, akRight] - AutoSize = False - Color = clInfoBk - ReadOnly = True - TabOrder = 3 - end - object edit_datatype: TEdit - Left = 87 - Top = 40 - Width = 203 - Height = 18 - Anchors = [akLeft, akTop, akRight] - AutoSize = False - Color = clInfoBk - ReadOnly = True - TabOrder = 4 - end - object edit_new: TCrossEdit - Left = 88 - Top = 88 - Width = 203 - Height = 18 - Anchors = [akLeft, akTop, akRight] - AutoSize = False - BorderStyle = bsNone - Color = clWhite - Font.Charset = DEFAULT_CHARSET - Font.Color = clWindowText - Font.Height = -11 - Font.Name = 'Tahoma' - Font.Style = [] - HideSelection = False - ParentFont = False - TabOrder = 5 - Text = '0000' - FocusAlignment = taLeftJustify - NoFocusAlignment = taLeftJustify - Precision = 15 - Decimals = 4 - FocusWidthInc = 0 - EditType = etHex - NextDialogOnEnter = True - DialogOnCursorKeys = True - NextPriorStep = 1 - AutoFocus = False - LimitCheck = True - Max = 2147483647.000000000000000000 - FocusColor = clWhite - NoFocusColor = clWhite - ErrorColor = clRed - StringCharSet = scFull - end - end -end Index: p/releases/0.29a2/src/Unit13_rawedit.pas =================================================================== --- /oup/releases/0.29a2/src/Unit13_rawedit.pas (revision 28) +++ (revision ) @@ -1,809 +1,0 @@ -UNIT Unit13_rawedit; -INTERFACE -USES - Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, - Dialogs, Wrapgrid, StdCtrls, Grids, StrUtils, MPHexEditor, ExtCtrls, Clipbrd, - Unit3_data, Unit2_functions, Unit9_data_structures, Unit4_exporters, Menus, Math; - -TYPE - TForm13 = Class(TForm) - Splitter1: TSplitter; - panel_data: TPanel; - hex: TMPHexEditor; - Splitter2: TSplitter; - structs: TWrapGrid; - value_viewer: TWrapGrid; - Splitter3: TSplitter; - value_viewer_context: TPopupMenu; - value_viewer_context_copy: TMenuItem; - value_viewer_context_copyashex: TMenuItem; - value_viewer_context_copyasdec: TMenuItem; - value_viewer_context_copyasfloat: TMenuItem; - value_viewer_context_copyasbitset: TMenuItem; - value_viewer_context_copyasstring: TMenuItem; - panel_files: TPanel; - opend: TOpenDialog; - saved: TSaveDialog; - panel_imexport: TPanel; - btn_export: TButton; - btn_import: TButton; - group_file: TGroupBox; - list: TListBox; - panel_extension: TPanel; - lbl_filter: TLabel; - combo_extension: TComboBox; - edit_filtername: TEdit; - check_filtername: TCheckBox; - GroupBox1: TGroupBox; - list_offset: TListBox; - Splitter4: TSplitter; - procedure hexKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState); - PROCEDURE list_offsetClick(Sender: TObject); - PROCEDURE LoadRaw(raw_info:TRawInfo); - PROCEDURE LoadFileNames; - PROCEDURE check_filternameClick(Sender: TObject); - PROCEDURE combo_extensionClick(Sender: TObject); - PROCEDURE panel_extensionResize(Sender: TObject); - PROCEDURE listClick(Sender: TObject); - PROCEDURE Recreatelist; - - PROCEDURE FormKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState); - PROCEDURE value_viewerDblClick(Sender: TObject); - PROCEDURE structsDblClick(Sender: TObject); - PROCEDURE value_viewer_context_copyClick(Sender: TObject); - PROCEDURE value_viewerMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); - PROCEDURE value_viewer_contextPopup(Sender: TObject); - 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); - 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 FormCloseQuery(Sender: TObject; var CanClose: Boolean); - PROCEDURE FormCreate(Sender: TObject); - PROCEDURE ClearValues; - PROCEDURE WriteValues; - PROCEDURE SetNewValue(datatype:Word; offset:LongWord; value:String); - PRIVATE - PUBLIC - END; - -VAR - Form13: TForm13; - -IMPLEMENTATION -{$R *.dfm} -USES Unit1_main, Unit12_ValueEdit; -VAR - fileid:LongWord; - dat_offset:LongWord; - fileid_opened,dat_offset_opened:LongWord; - - -PROCEDURE TForm13.LoadRaw(raw_info:TRawInfo); - VAR - i:LongWord; - data:Tdata; - mem:TMemoryStream; - BEGIN - IF hex.Modified THEN BEGIN - IF NOT Save THEN BEGIN - Exit; - END; - END; - IF list_offset.Count=0 THEN BEGIN - FOR i:=0 TO list.Count-1 DO BEGIN - IF GetFileIDByName(list.Items.Strings[i])=raw_info.src_id THEN BEGIN - list.ItemIndex:=i; - listClick(Self); - Break; - END; - END; - FOR i:=0 TO list_offset.Count-1 DO BEGIN - IF MidStr(list_offset.Items.Strings[i],3,8)=IntToHex(raw_info.src_offset,8) THEN BEGIN - list_offset.ItemIndex:=i; - Break; - END; - END; - END; - Self.ClearStructViewer; - SetLength(data,raw_info.raw_size); - LoadRawFilebyIDOffset(raw_info.src_id,raw_info.src_offset,@data[0]); - IF Length(data)>0 THEN BEGIN - hex.DataSize:=0; - hex.DataSize:=raw_info.raw_size; - FOR i:=0 TO High(data) DO - hex.Data[i]:=data[i]; - //WriteStructureInfos(GetStructureInfoId(GetFileInfo(fileid).Extension)); - structs.Height:=structs.RowCount*20; - IF structs.Height>120 THEN structs.Height:=120; - hexSelectionChanged(Self); - fileid_opened:=raw_info.src_id; - dat_offset_opened:=raw_info.src_offset; - hex.Modified:=False; - END ELSE BEGIN - ClearValues; - hex.DataSize:=0; - END; - END; - -PROCEDURE TForm13.Recreatelist; - VAR - i:LongWord; - exts:TStringList; - count:LongWord; - BEGIN - combo_extension.Items.Clear; - combo_extension.Items.Add('_All files_ ('{+IntToStr(dat_header.Files)}+')'); - exts:=GetExtensionsList; - FOR i:=0 TO High(RawListHandlers) DO BEGIN - count:=Length(GetFilesList(RawListHandlers[i].Ext,'',True)); - combo_extension.Items.Add(RawListHandlers[i].ext+' ('+IntToStr(count)+')'); - END; -// FOR i:=0 TO High(exts) DO -// combo_extension.Items.Add(exts[i]); - combo_extension.ItemIndex:=0; - combo_extensionClick(Self); - END; - -PROCEDURE TForm13.LoadFileNames; - VAR - Extension:String; - no_zero_bytes:Boolean; - pattern:String; - files:TStringList; - i:LongWord; - BEGIN - Extension:=MidStr(combo_extension.Items.Strings[combo_extension.ItemIndex],1,4); - pattern:=''; - IF check_filtername.Checked THEN pattern:=edit_filtername.Text; - IF Extension='_All' THEN BEGIN - Extension:=''; - FOR i:=0 TO High(RawListHandlers) DO BEGIN - IF Length(Extension)>0 THEN Extension:=Extension+','; - Extension:=Extension+RawListHandlers[i].Ext; - END; - END; - - files:=GetFilesList(extension,pattern,TRUE); - list.Items.Clear; - IF Length(files)>0 THEN - FOR i:=0 TO High(files) DO - list.Items.Add(files[i]); - list_offset.Items.Clear; - END; - -PROCEDURE TForm13.panel_extensionResize(Sender: TObject); - BEGIN - combo_extension.Width:=panel_extension.Width-5; - edit_filtername.Width:=panel_extension.Width-5; - END; - -PROCEDURE TForm13.combo_extensionClick(Sender: TObject); - BEGIN - LoadFileNames; - END; - -PROCEDURE TForm13.check_filternameClick(Sender: TObject); - BEGIN - edit_filtername.Enabled:=NOT check_filtername.Checked; - LoadFileNames; - END; - -PROCEDURE TForm13.listClick(Sender: TObject); - VAR - mem:TMemoryStream; - data:Tdata; - i:LongWord; - offsets:TRawList; - BEGIN - Self.ClearStructViewer; - IF hex.Modified THEN BEGIN - IF NOT Save THEN BEGIN - Exit; - END; - END; - ClearValues; - hex.DataSize:=0; - fileid:=GetFileIDByName(list.Items.Strings[list.ItemIndex]); - list_offset.Enabled:=True; - IF GetFileInfo(fileid).size>0 THEN BEGIN - offsets:=GetRawList(fileid); - list_offset.Items.Clear; - IF Length(offsets)>0 THEN BEGIN - FOR i:=0 TO High(offsets) DO BEGIN - list_offset.Items.Add('0x'+IntToHex(offsets[i].src_offset,8)+', '+IntToStr(offsets[i].raw_size)+' bytes'); - END; - END ELSE BEGIN - list_offset.Enabled:=False; - END; - END ELSE BEGIN - list_offset.Enabled:=False; - END; - END; - -PROCEDURE TForm13.list_offsetClick(Sender: TObject); - VAR - i:LongWord; - raw_info:TRawInfo; - BEGIN - Self.ClearStructViewer; - ClearValues; - dat_offset:=StrToInt('$'+MidStr(list_offset.Items.Strings[list_offset.ItemIndex],3,8)); - LoadRaw(GetRawInfo(fileid,dat_offset)); - END; - - - - -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 TForm13.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]); - 11: 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); - 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 TForm13.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 TForm13.ClearValues; - VAR - i:Byte; - BEGIN - FOR i:=1 TO value_viewer.RowCount-1 DO BEGIN - value_viewer.Cells[1,i]:=''; - END; - END; - -PROCEDURE TForm13.WriteValues; - VAR - i,j:Byte; - data:Tdata; - str:String; - value:LongWord; - BEGIN - FOR i:=1 TO value_viewer.RowCount-1 DO BEGIN - IF value_viewer.Cells[0,i]='1 byte, unsigned' THEN BEGIN - IF ((hex.SelCount=1) OR (hex.SelCount=0)) AND NOT ((hex.SelStart+1)>hex.DataSize) THEN BEGIN - value:=hex.Data[hex.SelStart]; - value_viewer.Cells[1,i]:=IntToStr( value )+' / 0x'+IntToHex( value , 2 ); - END ELSE - value_viewer.Cells[1,i]:=''; - END; - IF value_viewer.Cells[0,i]='2 bytes, unsigned' THEN BEGIN - IF ((hex.SelCount=2) OR (hex.SelCount=0)) AND NOT ((hex.SelStart+2)>hex.DataSize) THEN BEGIN - value:=hex.Data[hex.SelStart] + hex.Data[hex.SelStart+1]*256; - value_viewer.Cells[1,i]:=IntToStr( value )+' / 0x'+IntToHex( value , 4 ); - END ELSE - value_viewer.Cells[1,i]:=''; - END; - IF value_viewer.Cells[0,i]='4 bytes, unsigned' THEN BEGIN - IF ((hex.SelCount=4) OR (hex.SelCount=0)) AND NOT ((hex.SelStart+4)>hex.DataSize) THEN BEGIN - value:=hex.Data[hex.SelStart]+hex.Data[hex.SelStart+1]*256+hex.Data[hex.SelStart+2]*256*256+hex.Data[hex.SelStart+3]*256*256*256; - value_viewer.Cells[1,i]:=IntToStr( value )+' / 0x'+IntToHex( value , 8 ); - END ELSE - value_viewer.Cells[1,i]:=''; - END; - IF value_viewer.Cells[0,i]='Bitset' THEN BEGIN - IF (hex.SelCount<=8) THEN BEGIN - IF hex.SelCount=0 THEN BEGIN - SetLength(data,1); - data[0]:=hex.Data[hex.SelStart]; - END ELSE BEGIN - SetLength(data,hex.SelCount); - FOR j:=0 TO hex.SelCount-1 DO - data[j]:=hex.Data[hex.SelStart+j]; - END; - value_viewer.Cells[1,i]:=DataToBin(data); - END ELSE - value_viewer.Cells[1,i]:=''; - END; - IF value_viewer.Cells[0,i]='Float' THEN BEGIN - IF ((hex.SelCount=4) OR (hex.SelCount=0)) AND NOT ((hex.SelStart+4)>hex.DataSize) THEN BEGIN - SetLength(data,4); - FOR j:=0 TO 3 DO - data[j]:=hex.Data[hex.SelStart+j]; - value_viewer.Cells[1,i]:=FloatToStr(Decode_Float(data)); - END ELSE - value_viewer.Cells[1,i]:=''; - END; - IF value_viewer.Cells[0,i]='Selected length' THEN BEGIN - value_viewer.Cells[1,i]:=IntToStr(hex.SelCount)+' bytes'; - END; - IF value_viewer.Cells[0,i]='String' THEN BEGIN - j:=0; - str:=''; - IF hex.SelCount=0 THEN BEGIN -{ WHILE (hex.Data[hex.SelStart+j]>0) AND ((hex.SelStart+j)=32 THEN - str:=str+Char(hex.Data[hex.SelStart+j]) - ELSE - str:=str+'.'; - Inc(j); - END; -} END ELSE BEGIN - FOR j:=1 TO hex.SelCount DO - str:=str+Char(hex.Data[hex.SelStart+j-1]); - END; - value_viewer.Cells[1,i]:=str; - END; - END; - END; - -PROCEDURE TForm13.FormCreate(Sender: TObject); - BEGIN - Self.Caption:=''; - fileid:=0; - structs.Height:=40; - 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; - value_viewer.ColCount:=2; - value_viewer.RowCount:=8; - value_viewer.FixedRows:=1; - value_viewer.Cells[0,0]:='Type'; - value_viewer.Cells[1,0]:='Value'; - value_viewer.Cells[0,1]:='1 byte, unsigned'; - value_viewer.Cells[0,2]:='2 bytes, unsigned'; - value_viewer.Cells[0,3]:='4 bytes, unsigned'; - value_viewer.Cells[0,4]:='Bitset'; - value_viewer.Cells[0,5]:='Float'; - value_viewer.Cells[0,6]:='String'; - value_viewer.Cells[0,7]:='Selected length'; - value_viewer.ColWidths[0]:=100; - hex.Height:=panel_data.Height-215; - Self.panel_dataResize(Self); - END; - -FUNCTION TForm13.Save:Boolean; - VAR - mem:TMemoryStream; - data:Tdata; - i:LongWord; - BEGIN - CASE MessageBox(Self.Handle,PChar('Save changes to .raw-part of file '+GetFileInfo(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; - UpdateRawFile(GetRawInfo(fileid_opened,dat_offset_opened),@data[0]); - hex.Modified:=False; - FOR i:=0 TO hex.Datasize-1 DO hex.ByteChanged[i]:=False; - Result:=True; - END; - IDNO: Result:=True; - IDCANCEL: BEGIN - Result:=False; - END; - END; - END; - -PROCEDURE TForm13.FormCloseQuery(Sender: TObject; var CanClose: Boolean); - BEGIN - IF hex.Modified THEN BEGIN - IF NOT Save THEN CanClose:=False; - END; - END; - -PROCEDURE TForm13.ClearStructViewer; - VAR - x:Word; - BEGIN - structs.RowCount:=2; - FOR x:=0 TO structs.ColCount-1 DO structs.Cells[x,1]:=''; - structs.Enabled:=False; - structs.Height:=40; - END; - -PROCEDURE TForm13.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 TForm13.structsClick(Sender: TObject); - VAR - offset:LongWord; - length:Byte; - BEGIN - IF structs.Row>0 THEN BEGIN -{ offset:=structure_infos[GetStructureInfoId(GetFileInfo(fileid).extension)].entries[structs.Row-1].offset; - length:=GetTypeDataLength(structure_infos[GetStructureInfoId(GetFileInfo(fileid).extension)].entries[structs.Row-1].datatype); - hex.SelStart:=offset; - hex.SelEnd:=offset+length-1; -} END; - END; - -PROCEDURE TForm13.panel_dataResize(Sender: TObject); - BEGIN - structs.ColWidths[4]:=structs.Width-structs.ColWidths[0]-structs.ColWidths[1]-structs.ColWidths[2]-structs.ColWidths[3]-28; - value_viewer.ColWidths[1]:=value_viewer.Width-value_viewer.ColWidths[0]-28; - END; - -PROCEDURE TForm13.hexChange(Sender: TObject); - BEGIN - ClearValues; - IF hex.DataSize>0 THEN BEGIN -{ WriteStructureInfos(GetStructureInfoId(GetFileInfo(fileid).Extension)); - WriteValues; -} END; - END; - -PROCEDURE TForm13.hexKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState); - VAR - temps: String; - BEGIN - IF (Shift=[ssCtrl]) AND (Key=Ord('C')) THEN BEGIN - IF hex.SelCount>0 THEN BEGIN - IF hex.InCharField THEN - Clipboard.AsText:=hex.SelectionAsText - ELSE - Clipboard.AsText:=hex.SelectionAsHex; - END; - END; - IF (Shift=[ssCtrl]) AND (Key=Ord('V')) THEN BEGIN -{ temps:=Clipboard.AsText; - IF hex.SelStart+Length(temps)>hex.DataSize THEN - SetLength(temps, hex.DataSize-hex.SelStart); - hex.Sel - hex.SelCount:=Length(temps); - hex.ReplaceSelection(temps,Length(temps)); -} END; - END; - -PROCEDURE TForm13.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(GetFileInfo(fileid).Extension)>=0 THEN BEGIN - WITH structure_infos[GetStructureInfoId(GetFileInfo(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; -} WriteValues; - END; - END; - -PROCEDURE TForm13.FormClose(Sender: TObject; var Action: TCloseAction); - BEGIN - Action:=caFree; - Form1.close_window(Self.Name); - END; - -PROCEDURE TForm13.panel_imexportResize(Sender: TObject); - BEGIN - btn_import.Width:=panel_imexport.Width-8; - btn_export.Width:=panel_imexport.Width-8; - END; - -PROCEDURE TForm13.btn_exportClick(Sender: TObject); - VAR - fs:TFileStream; - BEGIN - saved.Filter:='Files of matching extension (*.'+GetFileInfo(fileid).Extension+')|*.'+dat_files[fileid].Extension+'|All files|*.*'; - saved.DefaultExt:=GetFileInfo(fileid).Extension; - IF saved.Execute THEN BEGIN - fs:=TFileStream.Create(saved.FileName,fmCreate); - hex.SaveToStream(fs); - fs.Free; - END; - END; - -PROCEDURE TForm13.btn_importClick(Sender: TObject); - VAR - data:Tdata; - fs:TFileStream; - BEGIN - opend.Filter:='Files of matching extension (*.'+GetFileInfo(fileid).Extension+')|*.'+dat_files[fileid].Extension+'|All files|*.*'; - IF opend.Execute THEN BEGIN - fs:=TFileStream.Create(opend.FileName,fmOpenRead); - IF fs.Size<>hex.DataSize 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(hex.datasize)+CrLf+ - 'Size of chosen file: '+FormatFileSize(fs.Size)); - END ELSE BEGIN - hex.LoadFromStream(fs); - hex.Modified:=True; - END; - fs.Free; - END; - END; - -PROCEDURE TForm13.FormActivate(Sender: TObject); - BEGIN - Form1.SetActiveWindow(Self.Name); - END; - -PROCEDURE TForm13.value_viewer_contextPopup(Sender: TObject); - VAR - i:Byte; - BEGIN - FOR i:=0 TO value_viewer_context.Items.Count-1 DO - value_viewer_context.Items.Items[i].Visible:=False; - WITH value_viewer DO BEGIN - IF (Col=1) AND (Row>0) AND (Length(Cells[Col,Row])>0) THEN BEGIN - IF Pos(' byte',Cells[0,Row])=2 THEN BEGIN - value_viewer_context.Items.Find('Copy to &clipboard').Visible:=True; - value_viewer_context.Items.Find('Copy to clipboard (as &dec)').Visible:=True; - value_viewer_context.Items.Find('Copy to clipboard (as &hex)').Visible:=True; - END; - IF Pos('Float',Cells[0,Row])=1 THEN - value_viewer_context.Items.Find('Copy to clipboard (as &float)').Visible:=True; - IF Pos('Bitset',Cells[0,Row])=1 THEN - value_viewer_context.Items.Find('Copy to clipboard (as &bitset)').Visible:=True; - IF Pos('String',Cells[0,Row])=1 THEN - value_viewer_context.Items.Find('Copy to clipboard (as &string)').Visible:=True; - IF Pos('Selected length',Cells[0,Row])=1 THEN - value_viewer_context.Items.Find('Copy to &clipboard').Visible:=True; - END; - END; - END; - -PROCEDURE TForm13.value_viewerMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); - VAR - ACol,ARow:Integer; - BEGIN - IF Button=mbRight THEN BEGIN - value_viewer.MouseToCell(x,y,ACol,ARow); - IF ARow>0 THEN BEGIN - value_viewer.Col:=ACol; - value_viewer.Row:=ARow; - END; - END; - END; - -PROCEDURE TForm13.value_viewer_context_copyClick(Sender: TObject); - VAR - i:Byte; - name:String; - value:LongWord; - BEGIN - name:=TMenuItem(Sender).Name; - IF Pos('asstring',name)>0 THEN BEGIN - Clipboard.AsText:=value_viewer.Cells[value_viewer.Col,value_viewer.Row]; - END ELSE - IF Pos('asfloat',name)>0 THEN BEGIN - Clipboard.AsText:=value_viewer.Cells[value_viewer.Col,value_viewer.Row]; - END ELSE - IF Pos('asbitset',name)>0 THEN BEGIN - Clipboard.AsText:=value_viewer.Cells[value_viewer.Col,value_viewer.Row]; - END ELSE - IF (Pos('ashex',name)>0) OR (Pos('asdec',name)>0) THEN BEGIN - IF value_viewer.Cells[0,value_viewer.Row]='1 byte, unsigned' THEN BEGIN - IF ((hex.SelCount=1) OR (hex.SelCount=0)) AND NOT ((hex.SelStart+1)>hex.DataSize) THEN - value:=hex.Data[hex.SelStart]; - END; - IF value_viewer.Cells[0,value_viewer.Row]='2 bytes, unsigned' THEN BEGIN - IF ((hex.SelCount=2) OR (hex.SelCount=0)) AND NOT ((hex.SelStart+2)>hex.DataSize) THEN - value:=hex.Data[hex.SelStart] + hex.Data[hex.SelStart+1]*256; - END; - IF value_viewer.Cells[0,value_viewer.Row]='4 bytes, unsigned' THEN BEGIN - IF ((hex.SelCount=4) OR (hex.SelCount=0)) AND NOT ((hex.SelStart+4)>hex.DataSize) THEN - value:=hex.Data[hex.SelStart]+hex.Data[hex.SelStart+1]*256+hex.Data[hex.SelStart+2]*256*256+hex.Data[hex.SelStart+3]*256*256*256; - END; - IF Pos('asdec',name)>0 THEN BEGIN - Clipboard.AsText:=IntToStr(value); - END ELSE BEGIN - IF value_viewer.Cells[0,value_viewer.Row]='1 byte, unsigned' THEN - Clipboard.AsText:='0x'+IntToHex(value,2); - IF value_viewer.Cells[0,value_viewer.Row]='2 bytes, unsigned' THEN - Clipboard.AsText:='0x'+IntToHex(value,4); - IF value_viewer.Cells[0,value_viewer.Row]='4 bytes, unsigned' THEN - Clipboard.AsText:='0x'+IntToHex(value,8); - END; - END ELSE BEGIN - Clipboard.AsText:=value_viewer.Cells[value_viewer.Col,value_viewer.Row]; - END; - END; - -PROCEDURE TForm13.structsDblClick(Sender: TObject); - VAR - offset:LongWord; - datatype:Word; - objectname:String; - value:String; - BEGIN - IF (structs.Row>0) AND (structs.Cells[structs.Col,0]='Value') THEN BEGIN -(* offset:=structure_infos[GetStructureInfoId(GetFileInfo(fileid).extension)].entries[structs.Row-1].offset; - datatype:=structure_infos[GetStructureInfoId(GetFileInfo(fileid).extension)].entries[structs.Row-1].datatype; - IF datatype<>11 THEN BEGIN - objectname:=structure_infos[GetStructureInfoId(GetFileInfo(fileid).extension)].entries[structs.Row-1].name; - value:=GetValue(datatype,offset); - Form12.MakeVarInput(objectname,offset,datatype,value,Self); - END ELSE BEGIN - {LOAD RAW-EDITOR} - END; -*) END; - END; - -PROCEDURE TForm13.SetNewValue(datatype:Word; offset:LongWord; value:String); - VAR - data:Tdata; - value_int:LongWord; - value_float:Single; - i:Word; - BEGIN - CASE datatype OF - 1..4: BEGIN - value_int:=StrToInt(value); - SetLength(data,datatype); - FOR i:=0 TO datatype-1 DO BEGIN - data[i]:=value_int MOD 256; - value_int:=value_int DIV 256; - END; - END; - 5..8: BEGIN - value_int:=StrToInt('$'+value); - SetLength(data,datatype-4); - FOR i:=0 TO datatype-5 DO BEGIN - data[i]:=value_int MOD 256; - value_int:=value_int DIV 256; - END; - END; - 9: BEGIN - value_float:=StrToFloat(value); - data:=Encode_Float(value_float); - END; - 10: BEGIN - value_int:=BinToInt(value); - SetLength(data,1); - data[0]:=value_int; - END; - 10000..65535: BEGIN - SetLength(data,datatype-10000); - FOR i:=1 TO datatype-10000 DO BEGIN - IF i<=Length(value) THEN - data[i-1]:=Ord(value[i]) - ELSE - data[i-1]:=0; - END; - END; - END; - FOR i:=0 TO High(data) DO BEGIN - IF hex.Data[offset+i]<>data[i] THEN hex.ByteChanged[offset+i]:=True; - hex.Data[offset+i]:=data[i]; - END; - hex.Modified:=True; - hexChange(Self); - hex.Repaint; - END; - -PROCEDURE TForm13.value_viewerDblClick(Sender: TObject); - VAR - offset:LongWord; - datatype:Word; - objectname:String; - value:String; - BEGIN - IF (value_viewer.Col=1) AND (Length(value_viewer.Cells[1,value_viewer.Row])>0) THEN BEGIN - offset:=hex.SelStart; - IF value_viewer.Cells[0,value_viewer.Row]='1 byte, unsigned' THEN - datatype:=1; - IF value_viewer.Cells[0,value_viewer.Row]='2 bytes, unsigned' THEN - datatype:=2; - IF value_viewer.Cells[0,value_viewer.Row]='4 bytes, unsigned' THEN - datatype:=4; - IF value_viewer.Cells[0,value_viewer.Row]='Bitset' THEN - datatype:=10; - IF value_viewer.Cells[0,value_viewer.Row]='Float' THEN - datatype:=9; - IF value_viewer.Cells[0,value_viewer.Row]='Selected length' THEN - Exit; - IF value_viewer.Cells[0,value_viewer.Row]='String' THEN BEGIN - IF hex.SelCount>0 THEN - datatype:=10000+hex.SelCount - ELSE - datatype:=10000+Length(value_viewer.Cells[1,value_viewer.Row]); - END; - objectname:=''; - value:=GetValue(datatype,offset); - Form12.MakeVarInput(objectname,offset,datatype,value,Self); - END; - END; - -PROCEDURE TForm13.FormKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState); - BEGIN - IF (Shift=[ssCtrl]) AND (Key=83) THEN - IF hex.Modified THEN - IF NOT Save THEN - Exit; - END; - -END. Index: p/releases/0.29a2/src/Unit14_settings.pas =================================================================== --- /oup/releases/0.29a2/src/Unit14_settings.pas (revision 28) +++ (revision ) @@ -1,155 +1,0 @@ -unit Unit14_settings; -interface -uses - Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, - Dialogs, StdCtrls, StrUtils; - -type - TForm14 = class(TForm) - check_filesashex: TCheckBox; - btn_ok: TButton; - btn_cancel: TButton; - btn_register_oldb: TButton; - btn_register_opf: TButton; - btn_register_dat: TButton; - procedure btn_register_opfClick(Sender: TObject); - procedure btn_register_oldbClick(Sender: TObject); - procedure btn_register_datClick(Sender: TObject); - procedure btn_cancelClick(Sender: TObject); - procedure btn_okClick(Sender: TObject); - procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean); - procedure FormShow(Sender: TObject); - function RegisterExtension(ext:String):Integer; - private - public - end; - -var - Form14: TForm14; - -implementation -{$R *.dfm} -uses - Unit1_main, Unit3_data, ftypesAPI; - -function ExtensionRegistered(ext:String; var RegisteredAs:String):Boolean; - var - ftr:TFileTypeRegistration; - begin - ftr:=TFileTypeRegistration.Create; - if(ftr <> nil) then begin - try - RegisteredAs:=ftr.GetInternalKey(ext); - if RegisteredAs<>'' then - Result:=True - else - Result:=False; - finally - ftr.Free; - end; - end; - end; - -function TForm14.RegisterExtension(ext:String):Integer; - var - ftr:TFileTypeRegistration; - temps:String; - warnmsg:String; - begin - Result:=-1; - if ExtensionRegistered(ext,temps) then begin - if temps<>'ONI'+ext then begin - warnmsg:=ext+'-files are not registered to OUP but as "'+temps+'"-files.'+#13+#10+ - 'Do you really want to unregister'+ext+'-files?'; - if MessageBox(Self.Handle, PChar(warnmsg),PChar('Warning'),MB_YESNO)=ID_NO then - Exit; - end; - ftr:=TFileTypeRegistration.Create; - if ftr<>nil then - try - if not ftr.UnregisterExtension(ext) then - ShowMessage('Could not unregister '+ext+'-files') - else - Result:=2; - finally - ftr.Free; - end; - end else begin - ftr:=TFileTypeRegistration.Create; - if ftr<>nil then begin - try - if ftr.RegisterType(ext,'ONI'+ext,'ONI '+ext+'-file',Application.EXEname+',1') then begin - ftr.AddHandler('open','"'+Application.EXEname+'" '+MidStr(ext,2,Length(ext)-1)+' "%1"'); - ftr.SetDefaultHandler; - Result:=1; - end; - finally - ftr.Free; - end; - end; - end; - end; - -procedure TForm14.btn_cancelClick(Sender: TObject); - begin - Self.Close; - end; - -procedure TForm14.btn_okClick(Sender: TObject); - begin - AppSettings.FilenumbersAsHex:=check_filesashex.Checked; - Self.Close; - end; - -procedure TForm14.btn_register_datClick(Sender: TObject); - begin - case RegisterExtension('.dat') of - 2: btn_register_dat.Caption:='Register .dat files with OUP'; - 1: btn_register_dat.Caption:='Unregister .dat files'; - end; - end; - -procedure TForm14.btn_register_oldbClick(Sender: TObject); - begin - case RegisterExtension('.oldb') of - 2: btn_register_oldb.Caption:='Register .oldb files with OUP'; - 1: btn_register_oldb.Caption:='Unregister .oldb files'; - end; - end; - -procedure TForm14.btn_register_opfClick(Sender: TObject); - begin - case RegisterExtension('.opf') of - 2: btn_register_opf.Caption:='Register .opf files with OUP'; - 1: btn_register_opf.Caption:='Unregister .opf files'; - end; - end; - -procedure TForm14.FormCloseQuery(Sender: TObject; var CanClose: Boolean); - begin - CanClose:=False; - Self.Visible:=False; - Form1.Enabled:=True; - Form1.SetFocus; - end; - -procedure TForm14.FormShow(Sender: TObject); - var - temps:String; - begin - if ExtensionRegistered('.dat',temps) then - btn_register_dat.Caption:='Unregister .dat files' - else - btn_register_dat.Caption:='Register .dat files with OUP'; - if ExtensionRegistered('.oldb',temps) then - btn_register_oldb.Caption:='Unregister .oldb files' - else - btn_register_oldb.Caption:='Register .oldb files with OUP'; - if ExtensionRegistered('.opf',temps) then - btn_register_opf.Caption:='Unregister .opf files' - else - btn_register_opf.Caption:='Register .opf files with OUP'; - check_filesashex.Checked:=AppSettings.FilenumbersAsHex; - end; - -end. Index: p/releases/0.29a2/src/Unit1_main.pas =================================================================== --- /oup/releases/0.29a2/src/Unit1_main.pas (revision 28) +++ (revision ) @@ -1,526 +1,0 @@ -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, Unit9_data_structures, - Unit10_leveldb, Unit4_exporters, Unit14_settings, - Unit5_preview, Unit7_txmpreplace, Unit8_binedit, Unit11_extractor, Unit13_rawedit; - -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; - menu_rawedit: TMenuItem; - menu_filecompare: TMenuItem; - ClosefileDB1: TMenuItem; - menu_sep4: TMenuItem; - menu_settings: TMenuItem; - menu_About: TMenuItem; - procedure menu_AboutClick(Sender: TObject); - PROCEDURE menu_settingsClick(Sender: TObject); - PROCEDURE ClosefileDB1Click(Sender: TObject); - PROCEDURE menu_filecompareClick(Sender: TObject); - PROCEDURE menu_raweditClick(Sender: TObject); - 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); - FUNCTION open_child(window_context:String):Boolean; - 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; - - IF MidStr(ParamStr(1),1,3)='opf' THEN BEGIN - ShowMessage('Load OPF-File: '+ParamStr(2)); - END ELSE IF MidStr(ParamStr(1),1,4)='oldb' THEN BEGIN - OpenDatabase(ParamStr(2)); - IF opened_state=opened_db THEN BEGIN - menu_tools.Enabled:=True; - menu_convert.Enabled:=False; - statbar.Panels.Items[0].Text:='OLDB loaded: '+ParamStr(2); - statbar.Panels.Items[1].Text:='Files: '+IntToStr(GetFilesCount); - statbar.Panels.Items[2].Text:='Extensions: '+IntToStr(Length(GetExtensionsList)); - END ELSE BEGIN - menu_tools.Enabled:=False; - menu_convert.Enabled:=True; - END; - END ELSE IF MidStr(ParamStr(1),1,3)='dat' THEN BEGIN - IF LoadDatInfos(ParamStr(2)) THEN BEGIN - Form1.Caption:='Oni Un/Packer '+version+' ('+ExtractFileName(ParamStr(2))+')'; - statbar.Panels.Items[0].Text:='.dat loaded: '+ParamStr(2); - statbar.Panels.Items[1].Text:='Files: '+IntToStr(dat_header.Files); - statbar.Panels.Items[2].Text:='Extensions: '+IntToStr(dat_header.Extensions); - menu_tools.Enabled:=True; - menu_convert.Enabled:=False; - END ELSE BEGIN - menu_convert.Enabled:=True; - ShowMessage('Error while loading the file:'+CrLf+ParamStr(2)+CrLf+'Perhaps not an Oni-.dat-file?'); - END; - 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.menu_AboutClick(Sender: TObject); - begin - ShowMessage('Will be implemented later ;)'); - end; - - - - -FUNCTION TForm1.open_child(window_context:String):Boolean; - VAR - rawEdit:TForm13; - binEdit:TForm8; - preview:TForm5; - txmpreplacer:TForm7; - extractor:TForm11; - menu_button:TMenuItem; - used:Array[1..9] OF Boolean; - i:Byte; - caption:String; - name:String; - BEGIN - Result:=True; - 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='rawedit' THEN - caption:='Binary .raw-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='rawedit' THEN BEGIN - rawEdit:=TForm13.Create(Application); - rawEdit.Name:=name; - rawEdit.Caption:=caption; - rawEdit.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 ELSE BEGIN - Result:=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: p/releases/0.29a2/src/Unit5_preview.pas =================================================================== --- /oup/releases/0.29a2/src/Unit5_preview.pas (revision 28) +++ (revision ) @@ -1,283 +1,0 @@ -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; - Splitter1: TSplitter; - lbl_notpossible: TLabel; - panel_files: TPanel; - list: TListBox; - panel_extension: TPanel; - lbl_filter: TLabel; - combo_extension: TComboBox; - check_zerobyte: TCheckBox; - edit_filtername: TEdit; - check_filtername: TCheckBox; - PROCEDURE LoadFileNames; - PROCEDURE check_filternameClick(Sender: TObject); - PROCEDURE check_zerobyteClick(Sender: TObject); - PROCEDURE combo_extensionClick(Sender: TObject); - PROCEDURE panel_extensionResize(Sender: TObject); - PROCEDURE listClick(Sender: TObject); - PROCEDURE Recreatelist; - - PROCEDURE FormActivate(Sender: TObject); - PROCEDURE PreviewTXAN; - PROCEDURE PreviewTXMB; - PROCEDURE PreviewTXMP; - 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(GetFilesCount)+')'); - 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.LoadFileNames; - VAR - Extension:String[4]; - no_zero_bytes:Boolean; - pattern:String; - files:TStringList; - i:LongWord; - BEGIN - Extension:=MidStr(combo_extension.Items.Strings[combo_extension.ItemIndex],1,4); - no_zero_bytes:=NOT check_zerobyte.Checked; - pattern:=''; - IF check_filtername.Checked THEN pattern:=edit_filtername.Text; - IF Extension='_All' THEN Extension:=''; - - files:=GetFilesList(extension,pattern,no_zero_bytes); - list.Items.Clear; - IF Length(files)>0 THEN - FOR i:=0 TO High(files) DO - list.Items.Add(files[i]); - END; - -PROCEDURE TForm5.panel_extensionResize(Sender: TObject); - BEGIN - combo_extension.Width:=panel_extension.Width-5; - edit_filtername.Width:=panel_extension.Width-5; - END; - -PROCEDURE TForm5.combo_extensionClick(Sender: TObject); - BEGIN - LoadFileNames; - END; - -PROCEDURE TForm5.check_zerobyteClick(Sender: TObject); - VAR - i:Byte; - BEGIN - LoadFileNames; - END; - -PROCEDURE TForm5.check_filternameClick(Sender: TObject); - BEGIN - edit_filtername.Enabled:=NOT check_filtername.Checked; - LoadFileNames; - END; - -PROCEDURE TForm5.listClick(Sender: TObject); - BEGIN - _fileid:=GetFileIDByName(list.Items.Strings[list.ItemIndex]); - 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.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 '+GetFileInfo(_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 '+GetFileInfo(_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:=GetFileIDByName(list_txmp.Items.Strings[list_txmp.ItemIndex]); - - 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:=GetFileIDByName(list_txmp.Items.Strings[list_txmp.ItemIndex]); - 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(GetFileIDByName(list_txmp.Items.Strings[list_txmp.ItemIndex])); - 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: p/releases/0.29a2/src/Unit8_binedit.pas =================================================================== --- /oup/releases/0.29a2/src/Unit8_binedit.pas (revision 28) +++ (revision ) @@ -1,869 +1,0 @@ -UNIT Unit8_binedit; -INTERFACE -USES - Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, - Dialogs, Wrapgrid, StdCtrls, Grids, StrUtils, MPHexEditor, ExtCtrls, Clipbrd, - Unit3_data, Unit2_functions, Unit9_data_structures, Unit4_exporters, Menus, Math, - VirtualTrees, VTHeaderPopup; - -TYPE - TForm8 = Class(TForm) - Splitter1: TSplitter; - panel_data: TPanel; - hex: TMPHexEditor; - Splitter2: TSplitter; - 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; - value_viewer: TWrapGrid; - Splitter3: TSplitter; - value_viewer_context: TPopupMenu; - value_viewer_context_copy: TMenuItem; - value_viewer_context_copyashex: TMenuItem; - value_viewer_context_copyasdec: TMenuItem; - value_viewer_context_copyasfloat: TMenuItem; - value_viewer_context_copyasbitset: TMenuItem; - value_viewer_context_copyasstring: TMenuItem; - check_zerobyte: TCheckBox; - edit_filtername: TEdit; - check_filtername: TCheckBox; - VST: TVirtualStringTree; - VTHPopup: TVTHeaderPopupMenu; - procedure VSTFocusChanged(Sender: TBaseVirtualTree; Node: PVirtualNode; - Column: TColumnIndex); - procedure VSTDblClick(Sender: TObject); - procedure VTHPopupColumnChange(const Sender: TBaseVirtualTree; - const Column: TColumnIndex; Visible: Boolean); - procedure VSTHeaderDragged(Sender: TVTHeader; Column: TColumnIndex; - OldPosition: Integer); - procedure VSTGetText(Sender: TBaseVirtualTree; Node: PVirtualNode; - Column: TColumnIndex; TextType: TVSTTextType; var CellText: WideString); - procedure hexKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState); - PROCEDURE LoadDat(_fileid:LongWord); - PROCEDURE LoadFileNames; - PROCEDURE check_filternameClick(Sender: TObject); - PROCEDURE check_zerobyteClick(Sender: TObject); - PROCEDURE combo_extensionClick(Sender: TObject); - PROCEDURE panel_extensionResize(Sender: TObject); - PROCEDURE listClick(Sender: TObject); - PROCEDURE Recreatelist; - - PROCEDURE FormKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState); - PROCEDURE value_viewerDblClick(Sender: TObject); - PROCEDURE value_viewer_context_copyClick(Sender: TObject); - PROCEDURE value_viewerMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); - PROCEDURE value_viewer_contextPopup(Sender: TObject); - 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); - FUNCTION GetValue(datatype:Word; offset:LongWord):String; - PROCEDURE WriteStructureInfos; //(structinfoid:Integer); - PROCEDURE hexSelectionChanged(Sender: TObject); - PROCEDURE hexChange(Sender: TObject); - PROCEDURE FormResize(Sender: TObject); - PROCEDURE ClearStructViewer; - PROCEDURE FormCloseQuery(Sender: TObject; var CanClose: Boolean); - PROCEDURE FormCreate(Sender: TObject); - PROCEDURE ClearValues; - PROCEDURE WriteValues; - PROCEDURE SetNewValue(datatype:Word; offset:LongWord; value:String); - PRIVATE - PUBLIC - END; - -VAR - Form8: TForm8; - -IMPLEMENTATION -{$R *.dfm} -USES Unit1_main, Unit12_ValueEdit, Unit13_rawedit; -VAR - fileid:LongWord; - -TYPE - PNodeData = ^TNodeData; - TNodeData = record - Caption:String; - Offset:LongInt; - DataType:Word; - Value:String; - Description:String; - end; - - -function AddVSTEntry(AVST:TCustomVirtualStringTree; ANode:PVirtualNode; ARecord:TNodeData):PVirtualNode; - var - data:PNodeData; - begin - Result:=AVST.AddChild(ANode); - data:=AVST.GetNodeData(Result); - AVST.ValidateNode(Result,False); - data^:=ARecord; - end; - - - -PROCEDURE TForm8.LoadDat(_fileid:LongWord); - VAR - i:LongWord; - mem:TMemoryStream; - data:Tdata; - BEGIN - IF hex.Modified THEN BEGIN - IF NOT Save THEN BEGIN - FOR i:=0 TO list.Count-1 DO BEGIN - IF GetFileIDByName(list.Items.Strings[i])=fileid THEN BEGIN - list.ItemIndex:=i; - Exit; - END; - END; - END; - END; - fileid:=_fileid; - FOR i:=0 TO list.Count-1 DO - IF GetFileIDByName(list.Items.Strings[i])=fileid THEN - list.ItemIndex:=i; - Self.ClearStructViewer; - 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; - END ELSE BEGIN - ClearValues; - hex.DataSize:=0; - END; - END; - -PROCEDURE TForm8.Recreatelist; - VAR - i:LongWord; - exts:TStringList; - BEGIN - combo_extension.Items.Clear; - combo_extension.Items.Add('_All files_ ('+IntToStr(GetFilesCount)+')'); - 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.LoadFileNames; - VAR - Extension:String[4]; - no_zero_bytes:Boolean; - pattern:String; - files:TStringList; - i:LongWord; - BEGIN - Extension:=MidStr(combo_extension.Items.Strings[combo_extension.ItemIndex],1,4); - no_zero_bytes:=NOT check_zerobyte.Checked; - pattern:=''; - IF check_filtername.Checked THEN pattern:=edit_filtername.Text; - IF Extension='_All' THEN Extension:=''; - - files:=GetFilesList(extension,pattern,no_zero_bytes); - list.Items.Clear; - IF Length(files)>0 THEN - FOR i:=0 TO High(files) DO - list.Items.Add(files[i]); - END; - -PROCEDURE TForm8.panel_extensionResize(Sender: TObject); - BEGIN - combo_extension.Width:=panel_extension.Width-5; - edit_filtername.Width:=panel_extension.Width-5; - END; - -PROCEDURE TForm8.combo_extensionClick(Sender: TObject); - BEGIN - LoadFileNames; - END; - -PROCEDURE TForm8.check_zerobyteClick(Sender: TObject); - VAR - i:Byte; - BEGIN - LoadFileNames; - END; - -PROCEDURE TForm8.check_filternameClick(Sender: TObject); - BEGIN - edit_filtername.Enabled:=NOT check_filtername.Checked; - LoadFileNames; - END; - -PROCEDURE TForm8.listClick(Sender: TObject); - VAR - mem:TMemoryStream; - data:Tdata; - i:LongWord; - BEGIN - LoadDat(GetFileIDByName(list.Items.Strings[list.ItemIndex])); - END; - - - - -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]); - 11: Result:='0x'+IntToHex(GetRawInfo(fileid,offset).raw_addr,8); - 12: Result:=FormatNumber(hex.data[offset+1]+hex.data[offset+2]*256+hex.data[offset+3]*256*256,5,'0'); - 13: Result:=IntToStr(hex.data[offset]); - 14: Result:=IntToStr(hex.data[offset]+hex.data[offset+1]*256); - 15: Result:=IntToStr(hex.data[offset]+hex.data[offset+1]*256+hex.data[offset+2]*256*256); - 16: Result:=IntToStr(hex.data[offset]+hex.data[offset+1]*256+hex.data[offset+2]*256*256+hex.data[offset+3]*256*256*256); - 1000..9999: BEGIN - Result:=''; - FOR i:=1 TO datatype-1000 DO BEGIN - IF hex.Data[offset+i-1]>=32 THEN - Result:=Result+Chr(hex.Data[offset+i-1]) - ELSE - Result:=Result+'.'; - END; - END; - 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; - VAR - i,j:LongWord; - pdata: PNodeData; - data: TNodeData; - node: PVirtualNode; - structs: TStructDef; - BEGIN - VST.BeginUpdate; - IF VST.RootNodeCount=0 THEN BEGIN - structs:=LoadStructureDefinition(fileid); - IF structs.data THEN BEGIN - IF Length(structs.Global)>0 THEN BEGIN - FOR i:=0 TO High(structs.Global) DO BEGIN - data.Caption:=structs.Global[i].name; - data.Offset:=structs.Global[i].offset; - data.DataType:=structs.Global[i].datatype; - data.Value:=GetValue(structs.Global[i].datatype, structs.Global[i].offset); - data.Description:=structs.Global[i].description; - AddVSTEntry(VST, nil, data); - END; - END; - IF Length(structs.Subs)>0 THEN BEGIN - FOR i:=0 TO High(structs.Subs) DO BEGIN - WITH structs.Subs[i] DO BEGIN - IF Length(Entries)>0 THEN BEGIN - IF Pos('#',SubName)>0 THEN BEGIN - data.Offset:=HexToLong(MidStr(SubName, Pos('#',SubName)+1, 8)); - data.Value:=MidStr(SubName, PosEx('#',SubName,Pos('#',SubName)+1)+1, 8); - data.Caption:=MidStr(SubName, 1, Pos('#',SubName)-1); - END ELSE BEGIN - data.Caption:=SubName; - data.Offset:=0; - data.Value:=''; - END; - data.DataType:=0; - data.Description:=''; - node:=AddVSTEntry(VST, nil, data); - FOR j:=0 TO High(Entries) DO BEGIN - data.Caption:=Entries[j].name; - data.Offset:=Entries[j].offset; - data.DataType:=Entries[j].datatype; - data.Value:=GetValue(Entries[j].datatype, Entries[j].offset); - data.Description:=Entries[j].description; - AddVSTEntry(VST, node, data); - END; - END; - END; - END; - END; - END; - IF VST.RootNodeCount>0 THEN - VST.FocusedNode:=VST.GetFirst; - END ELSE BEGIN - Node:=VST.GetFirst; - WHILE Assigned(Node) DO BEGIN - pdata:=VST.GetNodeData(Node); - IF pdata.DataType>0 THEN - pdata.Value:=GetValue(pdata.Datatype, pdata.Offset); - Node:=VST.GetNext(Node); - END; - END; - VST.EndUpdate; - END; - -PROCEDURE TForm8.ClearValues; - VAR - i:Byte; - BEGIN - FOR i:=1 TO value_viewer.RowCount-1 DO BEGIN - value_viewer.Cells[1,i]:=''; - END; - END; - -PROCEDURE TForm8.WriteValues; - VAR - i,j:Byte; - data:Tdata; - str:String; - value:LongWord; - BEGIN - FOR i:=1 TO value_viewer.RowCount-1 DO BEGIN - IF value_viewer.Cells[0,i]='1 byte, unsigned' THEN BEGIN - IF ((hex.SelCount=1) OR (hex.SelCount=0)) AND NOT ((hex.SelStart+1)>hex.DataSize) THEN BEGIN - value:=hex.Data[hex.SelStart]; - value_viewer.Cells[1,i]:=IntToStr( value )+' / 0x'+IntToHex( value , 2 ); - END ELSE - value_viewer.Cells[1,i]:=''; - END; - IF value_viewer.Cells[0,i]='2 bytes, unsigned' THEN BEGIN - IF ((hex.SelCount=2) OR (hex.SelCount=0)) AND NOT ((hex.SelStart+2)>hex.DataSize) THEN BEGIN - value:=hex.Data[hex.SelStart] + hex.Data[hex.SelStart+1]*256; - value_viewer.Cells[1,i]:=IntToStr( value )+' / 0x'+IntToHex( value , 4 ); - END ELSE - value_viewer.Cells[1,i]:=''; - END; - IF value_viewer.Cells[0,i]='4 bytes, unsigned' THEN BEGIN - IF ((hex.SelCount=4) OR (hex.SelCount=0)) AND NOT ((hex.SelStart+4)>hex.DataSize) THEN BEGIN - value:=hex.Data[hex.SelStart]+hex.Data[hex.SelStart+1]*256+hex.Data[hex.SelStart+2]*256*256+hex.Data[hex.SelStart+3]*256*256*256; - value_viewer.Cells[1,i]:=IntToStr( value )+' / 0x'+IntToHex( value , 8 ); - END ELSE - value_viewer.Cells[1,i]:=''; - END; - IF value_viewer.Cells[0,i]='Bitset' THEN BEGIN - IF (hex.SelCount<=8) THEN BEGIN - IF hex.SelCount=0 THEN BEGIN - SetLength(data,1); - data[0]:=hex.Data[hex.SelStart]; - END ELSE BEGIN - SetLength(data,hex.SelCount); - FOR j:=0 TO hex.SelCount-1 DO - data[j]:=hex.Data[hex.SelStart+j]; - END; - value_viewer.Cells[1,i]:=DataToBin(data); - END ELSE - value_viewer.Cells[1,i]:=''; - END; - IF value_viewer.Cells[0,i]='Float' THEN BEGIN - IF ((hex.SelCount=4) OR (hex.SelCount=0)) AND NOT ((hex.SelStart+4)>hex.DataSize) THEN BEGIN - SetLength(data,4); - FOR j:=0 TO 3 DO - data[j]:=hex.Data[hex.SelStart+j]; - value_viewer.Cells[1,i]:=FloatToStr(Decode_Float(data)); - END ELSE - value_viewer.Cells[1,i]:=''; - END; - IF value_viewer.Cells[0,i]='Selected length' THEN BEGIN - value_viewer.Cells[1,i]:=IntToStr(hex.SelCount)+' bytes'; - END; - IF value_viewer.Cells[0,i]='String' THEN BEGIN - j:=0; - str:=''; - IF hex.SelCount=0 THEN BEGIN -{ WHILE (hex.Data[hex.SelStart+j]>0) AND ((hex.SelStart+j)=32 THEN - str:=str+Char(hex.Data[hex.SelStart+j]) - ELSE - str:=str+'.'; - Inc(j); - END; -} END ELSE BEGIN - FOR j:=1 TO hex.SelCount DO - str:=str+Char(hex.Data[hex.SelStart+j-1]); - END; - value_viewer.Cells[1,i]:=str; - END; - END; - END; - -PROCEDURE TForm8.FormCreate(Sender: TObject); - BEGIN - Self.Caption:=''; - fileid:=0; - VST.NodeDataSize:=SizeOf(TNodeData); - value_viewer.ColCount:=2; - value_viewer.RowCount:=8; - value_viewer.FixedRows:=1; - value_viewer.Cells[0,0]:='Type'; - value_viewer.Cells[1,0]:='Value'; - value_viewer.Cells[0,1]:='1 byte, unsigned'; - value_viewer.Cells[0,2]:='2 bytes, unsigned'; - value_viewer.Cells[0,3]:='4 bytes, unsigned'; - value_viewer.Cells[0,4]:='Bitset'; - value_viewer.Cells[0,5]:='Float'; - value_viewer.Cells[0,6]:='String'; - value_viewer.Cells[0,7]:='Selected length'; - value_viewer.ColWidths[0]:=100; - hex.Height:=panel_data.Height-215; - END; - -FUNCTION TForm8.Save:Boolean; - VAR - mem:TMemoryStream; - data:Tdata; - i:LongWord; - BEGIN - CASE MessageBox(Self.Handle,PChar('Save changes to file '+GetFileInfo(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); - hex.Modified:=False; - FOR i:=0 TO hex.Datasize-1 DO hex.ByteChanged[i]:=False; - 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.ClearStructViewer; - BEGIN - VST.Clear; - 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.hexChange(Sender: TObject); - BEGIN - ClearValues; - IF hex.DataSize>0 THEN BEGIN - WriteStructureInfos; - WriteValues; - END; - END; - -PROCEDURE TForm8.hexKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState); - VAR - temps: String; - BEGIN - IF (Shift=[ssCtrl]) AND (Key=Ord('C')) THEN BEGIN - IF hex.SelCount>0 THEN BEGIN - IF hex.InCharField THEN - Clipboard.AsText:=hex.SelectionAsText - ELSE - Clipboard.AsText:=hex.SelectionAsHex; - END; - END; - IF (Shift=[ssCtrl]) AND (Key=Ord('V')) THEN BEGIN -{ temps:=Clipboard.AsText; - IF hex.SelStart+Length(temps)>hex.DataSize THEN - SetLength(temps, hex.DataSize-hex.SelStart); - hex.Sel - hex.SelCount:=Length(temps); - hex.ReplaceSelection(temps,Length(temps)); -} END; - END; - -PROCEDURE TForm8.hexSelectionChanged(Sender: TObject); - VAR - selstart:Integer; - i,j:Word; - - node:PVirtualNode; - pdata:PNodeData; - BEGIN - IF hex.DataSize>0 THEN BEGIN - selstart:=hex.SelStart; - IF VST.RootNodeCount>0 THEN BEGIN - Node:=VST.GetFirst; - WHILE Assigned(Node) DO BEGIN - pdata:=VST.GetNodeData(Node); - IF pdata.DataType>0 THEN BEGIN - IF ((selstart-pdata.Offset)=0) THEN BEGIN - VST.FocusedNode:=Node; - VST.Selected[Node]:=True; - Break; - END; - END; - Node:=VST.GetNext(Node); - END; - END; - 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 (*.'+GetFileInfo(fileid).Extension+')|*.'+dat_files[fileid].Extension+'|All files|*.*'; - saved.DefaultExt:=GetFileInfo(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 (*.'+GetFileInfo(fileid).Extension+')|*.'+dat_files[fileid].Extension+'|All files|*.*'; - IF opend.Execute THEN BEGIN - fs:=TFileStream.Create(opend.FileName,fmOpenRead); - IF fs.Size<>hex.DataSize 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(hex.datasize)+CrLf+ - 'Size of chosen file: '+FormatFileSize(fs.Size)); - END ELSE BEGIN - hex.LoadFromStream(fs); - hex.Modified:=True; - END; - fs.Free; - END; - END; - -PROCEDURE TForm8.FormActivate(Sender: TObject); - BEGIN - Form1.SetActiveWindow(Self.Name); - END; - -PROCEDURE TForm8.value_viewer_contextPopup(Sender: TObject); - VAR - i:Byte; - BEGIN - FOR i:=0 TO value_viewer_context.Items.Count-1 DO - value_viewer_context.Items.Items[i].Visible:=False; - WITH value_viewer DO BEGIN - IF (Col=1) AND (Row>0) AND (Length(Cells[Col,Row])>0) THEN BEGIN - IF Pos(' byte',Cells[0,Row])=2 THEN BEGIN - value_viewer_context.Items.Find('Copy to &clipboard').Visible:=True; - value_viewer_context.Items.Find('Copy to clipboard (as &dec)').Visible:=True; - value_viewer_context.Items.Find('Copy to clipboard (as &hex)').Visible:=True; - END; - IF Pos('Float',Cells[0,Row])=1 THEN - value_viewer_context.Items.Find('Copy to clipboard (as &float)').Visible:=True; - IF Pos('Bitset',Cells[0,Row])=1 THEN - value_viewer_context.Items.Find('Copy to clipboard (as &bitset)').Visible:=True; - IF Pos('String',Cells[0,Row])=1 THEN - value_viewer_context.Items.Find('Copy to clipboard (as &string)').Visible:=True; - IF Pos('Selected length',Cells[0,Row])=1 THEN - value_viewer_context.Items.Find('Copy to &clipboard').Visible:=True; - END; - END; - END; - -PROCEDURE TForm8.value_viewerMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); - VAR - ACol,ARow:Integer; - BEGIN - IF Button=mbRight THEN BEGIN - value_viewer.MouseToCell(x,y,ACol,ARow); - IF ARow>0 THEN BEGIN - value_viewer.Col:=ACol; - value_viewer.Row:=ARow; - END; - END; - END; - -PROCEDURE TForm8.value_viewer_context_copyClick(Sender: TObject); - VAR - i:Byte; - name:String; - value:LongWord; - BEGIN - name:=TMenuItem(Sender).Name; - IF Pos('asstring',name)>0 THEN BEGIN - Clipboard.AsText:=value_viewer.Cells[value_viewer.Col,value_viewer.Row]; - END ELSE - IF Pos('asfloat',name)>0 THEN BEGIN - Clipboard.AsText:=value_viewer.Cells[value_viewer.Col,value_viewer.Row]; - END ELSE - IF Pos('asbitset',name)>0 THEN BEGIN - Clipboard.AsText:=value_viewer.Cells[value_viewer.Col,value_viewer.Row]; - END ELSE - IF (Pos('ashex',name)>0) OR (Pos('asdec',name)>0) THEN BEGIN - IF value_viewer.Cells[0,value_viewer.Row]='1 byte, unsigned' THEN BEGIN - IF ((hex.SelCount=1) OR (hex.SelCount=0)) AND NOT ((hex.SelStart+1)>hex.DataSize) THEN - value:=hex.Data[hex.SelStart]; - END; - IF value_viewer.Cells[0,value_viewer.Row]='2 bytes, unsigned' THEN BEGIN - IF ((hex.SelCount=2) OR (hex.SelCount=0)) AND NOT ((hex.SelStart+2)>hex.DataSize) THEN - value:=hex.Data[hex.SelStart] + hex.Data[hex.SelStart+1]*256; - END; - IF value_viewer.Cells[0,value_viewer.Row]='4 bytes, unsigned' THEN BEGIN - IF ((hex.SelCount=4) OR (hex.SelCount=0)) AND NOT ((hex.SelStart+4)>hex.DataSize) THEN - value:=hex.Data[hex.SelStart]+hex.Data[hex.SelStart+1]*256+hex.Data[hex.SelStart+2]*256*256+hex.Data[hex.SelStart+3]*256*256*256; - END; - IF Pos('asdec',name)>0 THEN BEGIN - Clipboard.AsText:=IntToStr(value); - END ELSE BEGIN - IF value_viewer.Cells[0,value_viewer.Row]='1 byte, unsigned' THEN - Clipboard.AsText:='0x'+IntToHex(value,2); - IF value_viewer.Cells[0,value_viewer.Row]='2 bytes, unsigned' THEN - Clipboard.AsText:='0x'+IntToHex(value,4); - IF value_viewer.Cells[0,value_viewer.Row]='4 bytes, unsigned' THEN - Clipboard.AsText:='0x'+IntToHex(value,8); - END; - END ELSE BEGIN - Clipboard.AsText:=value_viewer.Cells[value_viewer.Col,value_viewer.Row]; - END; - END; - -procedure TForm8.VSTDblClick(Sender: TObject); - var - node:PVirtualNode; - nodedata:PNodeData; - begin - if VST.FocusedColumn=3 then begin - node:=VST.FocusedNode; - nodedata:=VST.GetNodeData(node); - - IF NOT (nodedata.datatype IN [11,12]) THEN BEGIN - Form12.MakeVarInput(nodedata.Caption,nodedata.offset,nodedata.datatype,nodedata.value,Self); - END ELSE BEGIN - IF nodedata.DataType=11 THEN BEGIN - IF GetRawInfo(fileid,nodedata.offset).raw_size>0 THEN BEGIN - IF Form1.open_child('rawedit') THEN BEGIN - TForm13(Form1.ActiveMDIChild).LoadRaw(GetRawInfo(fileid,nodedata.offset)); - END; - END; - END; - IF nodedata.DataType=12 THEN BEGIN - IF (StrToInt(nodedata.Value)0) AND - (StrToInt(nodedata.Value)<>fileid) THEN BEGIN - IF GetFileInfo(StrToInt(nodedata.Value)).Size>0 THEN BEGIN - IF Form1.open_child('binedit') THEN BEGIN - TForm8(Form1.ActiveMDIChild).LoadDat(StrToInt(nodedata.Value)); - END; - END ELSE BEGIN - ShowMessage('Linked filed is a zero-byte-file'); - END; - END; - END; - END; - - end; - end; - -procedure TForm8.VSTFocusChanged(Sender: TBaseVirtualTree; Node: PVirtualNode; - Column: TColumnIndex); - var - data:PNodeData; - begin - data:=VST.GetNodeData(node); - IF data.DataType>0 THEN BEGIN - hex.SelStart:=data.Offset; - hex.SelEnd:=data.Offset+GetTypeDataLength(data.DataType)-1; - END ELSE BEGIN - hex.SelStart:=data.Offset; - hex.SelEnd:=data.Offset+HexToLong(data.Value)-1; - END; -end; - -procedure TForm8.VSTGetText(Sender: TBaseVirtualTree; Node: PVirtualNode; - Column: TColumnIndex; TextType: TVSTTextType; var CellText: WideString); - var - data:PNodeData; - begin - data := Sender.GetNodeData(Node); - CellText := ''; - if TextType = ttNormal then begin - case Column of - 0: CellText := data.Caption; - 1: - if data.DataType>0 then - CellText := '0x'+IntToHex(data.Offset,8); - 2: - if data.DataType>0 then - CellText := GetDataType(data.DataType); - 3: - CellText := GetValue(data.DataType, data.Offset); - 4: - CellText := data.Description; - end; - end; - end; - -procedure TForm8.VSTHeaderDragged(Sender: TVTHeader; Column: TColumnIndex; - OldPosition: Integer); - begin - if Sender.Columns.Items[column].Position<1 then - Sender.Columns.Items[column].Position:=OldPosition; - end; - -procedure TForm8.VTHPopupColumnChange(const Sender: TBaseVirtualTree; - const Column: TColumnIndex; Visible: Boolean); - begin - if column=0 then - TVirtualStringTree(Sender).Header.Columns.Items[column].Options:=TVirtualStringTree(Sender).Header.Columns.Items[column].Options+[coVisible]; - end; - -PROCEDURE TForm8.SetNewValue(datatype:Word; offset:LongWord; value:String); - VAR - data:Tdata; - value_int:LongWord; - value_float:Single; - i:Word; - BEGIN - CASE datatype OF - 1..4: BEGIN - value_int:=StrToInt(value); - SetLength(data,datatype); - FOR i:=0 TO datatype-1 DO BEGIN - data[i]:=value_int MOD 256; - value_int:=value_int DIV 256; - END; - END; - 5..8: BEGIN - value_int:=StrToInt('$'+value); - SetLength(data,datatype-4); - FOR i:=0 TO datatype-5 DO BEGIN - data[i]:=value_int MOD 256; - value_int:=value_int DIV 256; - END; - END; - 9: BEGIN - value_float:=StrToFloat(value); - data:=Encode_Float(value_float); - END; - 10: BEGIN - value_int:=BinToInt(value); - SetLength(data,1); - data[0]:=value_int; - END; - 10000..65535: BEGIN - SetLength(data,datatype-10000); - FOR i:=1 TO datatype-10000 DO BEGIN - IF i<=Length(value) THEN - data[i-1]:=Ord(value[i]) - ELSE - data[i-1]:=0; - END; - END; - END; - FOR i:=0 TO High(data) DO BEGIN - IF hex.Data[offset+i]<>data[i] THEN hex.ByteChanged[offset+i]:=True; - hex.Data[offset+i]:=data[i]; - END; - hex.Modified:=True; - hexChange(Self); - hex.Repaint; - END; - -PROCEDURE TForm8.value_viewerDblClick(Sender: TObject); - VAR - offset:LongWord; - datatype:Word; - objectname:String; - value:String; - BEGIN - IF (value_viewer.Col=1) AND (Length(value_viewer.Cells[1,value_viewer.Row])>0) THEN BEGIN - offset:=hex.SelStart; - IF value_viewer.Cells[0,value_viewer.Row]='1 byte, unsigned' THEN - datatype:=1; - IF value_viewer.Cells[0,value_viewer.Row]='2 bytes, unsigned' THEN - datatype:=2; - IF value_viewer.Cells[0,value_viewer.Row]='4 bytes, unsigned' THEN - datatype:=4; - IF value_viewer.Cells[0,value_viewer.Row]='Bitset' THEN - datatype:=10; - IF value_viewer.Cells[0,value_viewer.Row]='Float' THEN - datatype:=9; - IF value_viewer.Cells[0,value_viewer.Row]='Selected length' THEN - Exit; - IF value_viewer.Cells[0,value_viewer.Row]='String' THEN BEGIN - IF hex.SelCount>0 THEN - datatype:=10000+hex.SelCount - ELSE - datatype:=10000+Length(value_viewer.Cells[1,value_viewer.Row]); - END; - objectname:=''; - value:=GetValue(datatype,offset); - Form12.MakeVarInput(objectname,offset,datatype,value,Self); - END; - END; - -PROCEDURE TForm8.FormKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState); - BEGIN - IF (Shift=[ssCtrl]) AND (Key=83) THEN - IF hex.Modified THEN - IF NOT Save THEN - Exit; - END; - - -END. Index: p/releases/0.29a2/src/Unit9_data_structures.pas =================================================================== --- /oup/releases/0.29a2/src/Unit9_data_structures.pas (revision 28) +++ (revision ) @@ -1,501 +1,0 @@ -UNIT Unit9_data_structures; -INTERFACE -USES SysUtils, ABSMain, DB, ABSDecUtil, Classes, Unit3_data, Dialogs, StrUtils; - -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 - // 11 : raw-addr - // 12 : dat-file-ID - // 13..16: Signed Integer[1..4] - // 1000..9999: Unused data[0-8999] - // 10000+: string[0+] - description:String; - END; - TStructDefSub=RECORD - SubName:String; - Entries:Array OF TStructure_entry; - END; - TStructDef=RECORD - Data:Boolean; - Global:Array OF TStructure_entry; - Subs:Array OF TStructDefSub; - END; - THandler=FUNCTION(fileid:LongWord):TRawList; - TRawListHandlers=RECORD - Ext:String[4]; - needed:Boolean; - Handler:THandler; - END; - -VAR - RawListHandlers:Array OF TRawListHandlers; - - -FUNCTION LoadStructureDefinition(fileid:LongWord):TStructDef; -FUNCTION GetDataType(typeid:Word):String; -FUNCTION GetTypeDataLength(datatype:Word):Word; -FUNCTION GetRawInfo(fileid,dat_offset:LongWord):TRawInfo; -FUNCTION GetRawList(fileid:LongWord):TRawList; - - -IMPLEMENTATION -USES Unit2_functions, Forms; - -FUNCTION GetTypeDataLength(datatype:Word):Word; - BEGIN - CASE datatype OF - 1..4: Result:=datatype; - 5..8: Result:=datatype-4; - 9: Result:=4; - 10: Result:=1; - 11: Result:=4; - 12: Result:=4; - 13..16: Result:=datatype-12; - 1000..9999: Result:=datatype-1000; - 10000..65535: Result:=datatype-10000; - END; - 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'; - 11: Result:='Raw-Address'; - 12: Result:='.dat-file-ID'; - 13..16: Result:='SignedInt'+IntToStr((typeid-12)*8); - 1000..9999: Result:='Unused('+IntToStr(typeid-1000)+')'; - 10000..65535: Result:='String('+IntToStr(typeid-10000)+')'; - END; - END; - - -FUNCTION GetRawInfo(fileid,dat_offset:LongWord):TRawInfo; - VAR - i:LongWord; - raw_list:TRawList; - BEGIN - raw_list:=GetRawList(fileid); - Result.src_id:=0; - Result.src_offset:=0; - Result.raw_addr:=0; - Result.raw_size:=0; - FOR i:=0 TO High(raw_list) DO BEGIN - IF raw_list[i].src_offset=dat_offset THEN BEGIN - Result.src_id:=fileid; - Result.src_offset:=raw_list[i].src_offset; - Result.raw_addr:=raw_list[i].raw_addr; - Result.raw_size:=raw_list[i].raw_size; - Result.loc_sep:=raw_list[i].loc_sep; - Break; - END; - END; - END; - -FUNCTION GetRawList(fileid:LongWord):TRawList; - VAR - i:LongWord; - Query:TABSQuery; - BEGIN - IF opened_state=opened_dat THEN BEGIN - FOR i:=0 TO High(RawListHandlers) DO - IF UpperCase(RawListHandlers[i].Ext)=UpperCase(dat_files[fileid].extension) THEN - IF RawListHandlers[i].needed THEN BEGIN - Result:=RawListHandlers[i].Handler(fileid); - Break; - END ELSE - Break; - END ELSE BEGIN - SetLength(Result,0); - Query.SQL.Text:='SELECT [src_link_offset],[size] FROM rawmap WHERE [src_id]='+IntToStr(fileid)+' ORDER BY src_link_offset ASC;'; - Query.Open; - IF Query.RecordCount>0 THEN BEGIN - Query.First; - SetLength(Result,Query.RecordCount); - i:=0; - REPEAT - Result[i].src_id:=fileid; - Result[i].src_offset:=Query.FieldByName('src_link_offset').AsInteger; - Result[i].raw_addr:=0; - Result[i].raw_size:=Query.FieldByName('size').AsInteger; - Inc(i); - Query.Next; - UNTIL Query.EOF; - END; - Query.Close; - END; - END; - - -FUNCTION AGDB(fileid:LongWord):TRawList; - VAR - link:LongWord; - links:LongWord; - i:LongWord; - BEGIN - IF NOT dat_os_mac THEN BEGIN - LoadDatFilePart(fileid,$1C,4,@links); - links:=links*2; - SetLength(Result,links); - FOR i:=0 TO links-1 DO BEGIN - Result[i].src_offset:=$20+i*4; - LoadDatFilePart(fileid,$20+i*4,4,@link); - Result[i].raw_addr:=link; - Result[i].raw_size:=0{????????????????????????????????}; - Result[i].loc_sep:=False; - END; - END; - END; -FUNCTION AKVA(fileid:LongWord):TRawList; - VAR - link:LongWord; - links:LongWord; - i:LongWord; - BEGIN - IF NOT dat_os_mac THEN BEGIN - LoadDatFilePart(fileid,$1C,4,@links); - SetLength(Result,links); - FOR i:=0 TO links-1 DO BEGIN - Result[i].src_offset:=$20+i*$74+$24; - LoadDatFilePart(fileid,$20+i*$74+$24,4,@link); - Result[i].raw_addr:=link; - LoadDatFilePart(fileid,$20+i*$74+$28,4,@link); - Result[i].raw_size:=link; - Result[i].loc_sep:=False; - END; - END; - END; -FUNCTION BINA(fileid:LongWord):TRawList; - VAR - link:LongWord; - datasize:LongWord; - BEGIN - LoadDatFilePart(fileid,$0C,4,@link); - LoadDatFilePart(fileid,$08,4,@datasize); - SetLength(Result,1); - Result[0].src_offset:=$0C; - Result[0].raw_addr:=link; - Result[0].raw_size:=datasize; - Result[0].loc_sep:=dat_os_mac; - END; -FUNCTION OSBD(fileid:LongWord):TRawList; - VAR - link:LongWord; - datasize:LongWord; - BEGIN - LoadDatFilePart(fileid,$08,4,@datasize); - LoadDatFilePart(fileid,$0C,4,@link); - SetLength(Result,1); - Result[0].src_offset:=$0C; - Result[0].raw_addr:=link; - Result[0].raw_size:=datasize; - Result[0].loc_sep:=dat_os_mac; - END; -FUNCTION SNDD(fileid:LongWord):TRawList; - VAR - link:LongWord; - datasize:LongWord; - BEGIN - IF NOT dat_os_mac THEN BEGIN - LoadDatFilePart(fileid,$40,4,@datasize); - LoadDatFilePart(fileid,$44,4,@link); - Result[0].src_offset:=$44; - END ELSE BEGIN - LoadDatFilePart(fileid,$10,4,@datasize); - LoadDatFilePart(fileid,$14,4,@link); - Result[0].src_offset:=$14; - END; - SetLength(Result,1); - Result[0].raw_addr:=link; - Result[0].raw_size:=datasize; - Result[0].loc_sep:=False; - END; -FUNCTION SUBT(fileid:LongWord):TRawList; - VAR - baselink,link:LongWord; - links:LongWord; - i,j,k:LongWord; - data:Tdata; - BEGIN - LoadDatFilePart(fileid,$18,4,@baselink); - LoadDatFilePart(fileid,$1C,4,@links); - IF links>0 THEN BEGIN - LoadDatFilePart(fileid,$20+(links-1)*4,4,@link); - SetLength(data,link+1024); - LoadRawFile(fileid,$1C,baselink,link+1024,False,@data[0]); - k:=0; - FOR j:=0 TO 1024 DO BEGIN - IF (data[link+j]=$00) OR (j=1024) THEN BEGIN - IF j<1024 THEN BEGIN - IF k=0 THEN BEGIN - k:=1; - END ELSE BEGIN - SetLength(Result,1); - Result[0].src_offset:=$18; - Result[0].raw_addr:=baselink; - Result[0].raw_size:=link+j; - Break; - END; - END; - END; - END; - END; - END; -FUNCTION TRAM(fileid:LongWord):TRawList; - VAR - i:Byte; - link:LongWord; - frames:Word; - tempb:Byte; - tempw:Word; - templ:LongWord; - data:Tdata; - offset:Word; - BEGIN - SetLength(Result,13); - LoadDatFilePart(fileid,$16C,2,@frames); - {y-pos} - LoadDatFilePart(fileid,$0C,4,@link); - Result[0].src_offset:=$0C; - Result[0].raw_addr:=link; - Result[0].raw_size:=frames*4; - {x-z-pos} - LoadDatFilePart(fileid,$10,4,@link); - Result[1].src_offset:=$10; - Result[1].raw_addr:=link; - Result[1].raw_size:=frames*8; - {attacks} - LoadDatFilePart(fileid,$182,1,@tempb); - LoadDatFilePart(fileid,$14,4,@link); - Result[2].src_offset:=$14; - Result[2].raw_addr:=link; - Result[2].raw_size:=tempb*32; - {damage} - LoadDatFilePart(fileid,$183,1,@tempb); - LoadDatFilePart(fileid,$18,4,@link); - Result[3].src_offset:=$18; - Result[3].raw_addr:=link; - Result[3].raw_size:=tempb*8; - {motionblur} - LoadDatFilePart(fileid,$184,1,@tempb); - LoadDatFilePart(fileid,$1C,4,@link); - Result[4].src_offset:=$1C; - Result[4].raw_addr:=link; - Result[4].raw_size:=tempb*8; - {shortcut} - LoadDatFilePart(fileid,$185,1,@tempb); - LoadDatFilePart(fileid,$20,4,@link); - Result[5].src_offset:=$20; - Result[5].raw_addr:=link; - Result[5].raw_size:=tempb*8; - {throw} - LoadDatFilePart(fileid,$24,4,@link); - Result[6].src_offset:=$24; - Result[6].raw_addr:=link; - IF link>0 THEN - Result[6].raw_size:=24 - ELSE - Result[6].raw_size:=0; - {footstep} - LoadDatFilePart(fileid,$186,1,@tempb); - LoadDatFilePart(fileid,$28,4,@link); - Result[7].src_offset:=$28; - Result[7].raw_addr:=link; - Result[7].raw_size:=tempb*4; - {particle} - LoadDatFilePart(fileid,$187,1,@tempb); - LoadDatFilePart(fileid,$2C,4,@link); - Result[8].src_offset:=$2C; - Result[8].raw_addr:=link; - Result[8].raw_size:=tempb*24; - {position} - LoadDatFilePart(fileid,$30,4,@link); - Result[9].src_offset:=$30; - Result[9].raw_addr:=link; - Result[9].raw_size:=frames*8; - {particle} - LoadDatFilePart(fileid,$154,2,@tempw); - LoadDatFilePart(fileid,$38,4,@link); - Result[11].src_offset:=$38; - Result[11].raw_addr:=link; - Result[11].raw_size:=tempw*34; - {extent} - LoadDatFilePart(fileid,$138,4,@templ); - LoadDatFilePart(fileid,$13C,4,@link); - Result[12].src_offset:=$13C; - Result[12].raw_addr:=link; - Result[12].raw_size:=templ*12; - - LoadDatFilePart(fileid,$34,4,@link); - tempw:=0; - IF link>0 THEN BEGIN - {BODY ANIMATIONS PART DECODE!!!} - SetLength(data,$FFFF); - LoadRawFile(fileid,$34,link,$FFFF,False,@data[0]); - offset:=data[24]+data[25]*255; - {} - END; - Result[10].src_offset:=$34; - Result[10].raw_addr:=link; - Result[10].raw_size:=tempw; - END; -FUNCTION TXMP(fileid:LongWord):TRawList; - VAR - link_pc:LongWord; - link_mac:LongWord; - x,y:Word; - storetype:Byte; - datasize:LongWord; - BEGIN - LoadDatFilePart(fileid,$8C,SizeOf(x),@x); - LoadDatFilePart(fileid,$8E,SizeOf(y),@y); - LoadDatFilePart(fileid,$90,SizeOf(storetype),@storetype); - LoadDatFilePart(fileid,$9C,4,@link_pc); - LoadDatFilePart(fileid,$A0,4,@link_mac); - CASE storetype OF - 0,1,2: datasize:=x*y*2; - 8: datasize:=x*y*4; - 9: datasize:=x*y DIV 2; - END; - SetLength(Result,1); - IF NOT dat_os_mac THEN BEGIN - Result[0].src_offset:=$9C; - Result[0].raw_addr:=link_pc - END ELSE BEGIN - Result[0].src_offset:=$A0; - Result[0].raw_addr:=link_mac; - END; - Result[0].raw_size:=datasize; - Result[0].loc_sep:=dat_os_mac; - END; - - -PROCEDURE InsertRawListHandler(ext:String; needed:Boolean; handler:THandler); - BEGIN - SetLength(RawListHandlers,Length(RawListHandlers)+1); - RawListHandlers[High(RawListHandlers)].Ext:=ext; - RawListHandlers[High(RawListHandlers)].needed:=needed; - RawListHandlers[High(RawListHandlers)].handler:=handler; - END; - - - -FUNCTION LoadStructureDefinition(fileid:LongWord):TStructDef; - VAR - i:LongWord; - current_type:Byte; //0: Global, 1: Undynamic, 2: Dynamic - current_base,current_package,current_package_size:LongWord; - packages:LongWord; - deffile:Text; - structentry:TStructure_Entry; - fields:TStringList; - filename:String; - ext:String[4]; - temps:String; - data:TData; - BEGIN - SetLength(Result.Global,0); - SetLength(Result.Subs,0); - Result.Data:=False; - ext:=GetFileInfo(fileid).Extension; - filename:=ExtractFilePath(Application.ExeName)+'\StructDefs\'+ext+'.txt'; - IF FileExists(filename) THEN BEGIN - data:=LoadDatFile(fileid); - AssignFile(deffile,filename); - Reset(deffile); - current_type:=0; - Result.Data:=True; - IF NOT EoF(deffile) THEN BEGIN - ReadLn(deffile,temps); - WHILE NOT EoF(deffile) DO BEGIN - ReadLn(deffile,temps); - IF Length(temps)>0 THEN BEGIN - IF temps[1]='*' THEN BEGIN - fields:=Explode(temps,'#'); - CASE Length(fields) OF - 1: BEGIN - current_type:=1; - current_base:=0; - SetLength(Result.Subs, Length(Result.Subs)+1); - Result.Subs[High(Result.Subs)].SubName:=MidStr(fields[0],2,Length(fields[0])-1); - END; - 2: BEGIN - current_type:=1; - current_base:=HexToLong(fields[1]); - SetLength(Result.Subs, Length(Result.Subs)+1); - Result.Subs[High(Result.Subs)].SubName:=MidStr(fields[0],2,Length(fields[0])-1); - END; - 5: BEGIN - current_type:=2; - current_base:=HexToLong(fields[1]); - current_package:=0; - current_package_size:=StrToInt(fields[4]); - CASE StrToInt(fields[3]) OF - 1: packages:=data[HexToLong(fields[2])]; - 2: packages:=data[HexToLong(fields[2])]+data[HexToLong(fields[2])+1]*256; - 4: packages:=data[HexToLong(fields[2])]+data[HexToLong(fields[2])+1]*256+data[HexToLong(fields[2])+2]*256*256+data[HexToLong(fields[2])+3]*256*256*256; - END; - SetLength(Result.Subs, Length(Result.Subs)+packages); - FOR current_package:=0 TO packages-1 DO BEGIN - Result.Subs[High(Result.Subs)-packages+current_package+1].SubName:= - MidStr(fields[0],2,Length(fields[0])-1)+'['+IntToStr(current_package)+']'+ - '#'+IntToHex(current_base+current_package*current_package_size,8)+ - '#'+IntToHex(current_package_size,8); - END; - END; - END; - END ELSE BEGIN - fields:=Explode(temps,#9); - IF (Length(fields)=3) OR (Length(fields)=4) THEN BEGIN - structentry.name:=fields[0]; - structentry.datatype:=StrToInt(fields[2]); - IF Length(fields)=4 THEN - structentry.description:=fields[3] - ELSE - structentry.description:=''; - IF current_type IN [0,1] THEN BEGIN - structentry.offset:=HexToLong(fields[1])+current_base; - IF Length(Result.Subs)=0 THEN BEGIN - SetLength(Result.Global,Length(Result.Global)+1); - Result.Global[High(Result.Global)]:=structentry; - END ELSE BEGIN - SetLength(Result.Subs[High(Result.Subs)].Entries,Length(Result.Subs[High(Result.Subs)].Entries)+1); - Result.Subs[High(Result.Subs)].Entries[High(Result.Subs[High(Result.Subs)].Entries)]:=structentry; - END; - END ELSE BEGIN - FOR current_package:=0 TO packages-1 DO BEGIN - structentry.offset:=current_base+current_package*current_package_size+HexToLong(fields[1]); - WITH Result.Subs[High(Result.Subs)-packages+current_package+1] DO BEGIN - SetLength(Entries,Length(Entries)+1); - Entries[High(Entries)]:=structentry; - END; - END; - END; - END; - END; - END; - END; - END; - CloseFile(deffile); - END; - END; - - -BEGIN -// InsertRawListHandler('AGDB',True,AGDB); - InsertRawListHandler('AKVA',True,AKVA); - InsertRawListHandler('BINA',True,BINA); - InsertRawListHandler('OSBD',True,OSBD); - InsertRawListHandler('SNDD',True,SNDD); - InsertRawListHandler('SUBT',True,SUBT); - InsertRawListHandler('TRAM',True,TRAM); - InsertRawListHandler('TXMP',True,TXMP); -END.