Index: oup/releases/0.30a/OniUnPacker.bdsproj
===================================================================
--- oup/releases/0.30a/OniUnPacker.bdsproj (revision 33)
+++ oup/releases/0.30a/OniUnPacker.bdsproj (revision 33)
@@ -0,0 +1,183 @@
+
+
+
+
+
+
+
+
+
+
+
+ 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: oup/releases/0.30a/OniUnPacker.cfg
===================================================================
--- oup/releases/0.30a/OniUnPacker.cfg (revision 33)
+++ oup/releases/0.30a/OniUnPacker.cfg (revision 33)
@@ -0,0 +1,40 @@
+-$A8
+-$B-
+-$C+
+-$D+
+-$E-
+-$F-
+-$G+
+-$H+
+-$I+
+-$J-
+-$K-
+-$L+
+-$M-
+-$N+
+-$O+
+-$P+
+-$Q-
+-$R-
+-$S-
+-$T-
+-$U-
+-$V+
+-$W-
+-$X+
+-$YD
+-$Z1
+-cg
+-AWinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE;
+-H+
+-W+
+-M
+-$M16384,1048576
+-K$00400000
+-E"exe"
+-N0"dcu"
+-LE"C:\Dokumente und Einstellungen\Administrator\Eigene Dateien\Borland Studio Projects\Bpl"
+-LN"C:\Dokumente und Einstellungen\Administrator\Eigene Dateien\Borland Studio Projects\Bpl"
+-w-UNSAFE_TYPE
+-w-UNSAFE_CODE
+-w-UNSAFE_CAST
Index: oup/releases/0.30a/OniUnPacker.dpr
===================================================================
--- oup/releases/0.30a/OniUnPacker.dpr (revision 33)
+++ oup/releases/0.30a/OniUnPacker.dpr (revision 33)
@@ -0,0 +1,32 @@
+PROGRAM OniUnPacker;
+uses
+ Forms,
+ Unit1_main in 'Unit1_main.pas' {Form1},
+ Unit2_functions in 'Unit2_functions.pas',
+ Unit3_data in 'Unit3_data.pas',
+ Unit4_Exporters in 'Unit4_Exporters.pas',
+ Unit5_preview in 'Unit5_preview.pas' {Form5},
+ Unit6_imgfuncs in 'Unit6_imgfuncs.pas',
+ Unit7_txmpreplace in 'Unit7_txmpreplace.pas' {Form7},
+ Unit8_binedit in 'Unit8_binedit.pas' {Form8},
+ Unit9_data_structures in 'Unit9_data_structures.pas',
+ Unit10_leveldb in 'Unit10_leveldb.pas' {Form10},
+ Unit11_extractor in 'Unit11_extractor.pas' {Form11},
+ Unit12_ValueEdit in 'Unit12_ValueEdit.pas' {Form12},
+ Unit13_rawedit in 'Unit13_rawedit.pas' {Form13},
+ Unit14_settings in 'Unit14_settings.pas' {Form14},
+ ftypesAPI in 'TFileTypeRegistration\ftypesAPI.pas',
+ Unit15_Classes in 'Unit15_Classes.pas';
+
+{$R *.res}
+{$R icon2.res}
+
+BEGIN
+ Application.Initialize;
+ Application.Title:='Oni Un/Packer';
+ Application.CreateForm(TForm1, Form1);
+ Application.CreateForm(TForm10, Form10);
+ Application.CreateForm(TForm12, Form12);
+ Application.CreateForm(TForm14, Form14);
+ Application.Run;
+END.
Index: oup/releases/0.30a/TFileTypeRegistration/IsAdmin.inc
===================================================================
--- oup/releases/0.30a/TFileTypeRegistration/IsAdmin.inc (revision 33)
+++ oup/releases/0.30a/TFileTypeRegistration/IsAdmin.inc (revision 33)
@@ -0,0 +1,90 @@
+function GetAdminSid: PSID;
+const
+ // bekannte SIDs ... (WinNT.h)
+ SECURITYNTAUTHORITY: TSIDIdentifierAuthority = (Value: (0, 0, 0, 0, 0, 5));
+ // bekannte RIDs ... (WinNT.h)
+ SECURITYBUILTINDOMAINRID: DWORD = $00000020;
+ DOMAINALIASRIDADMINS: DWORD = $00000220;
+begin
+ Result := nil;
+ AllocateAndInitializeSid(SECURITYNTAUTHORITY,
+ 2,
+ SECURITYBUILTINDOMAINRID,
+ DOMAINALIASRIDADMINS,
+ 0,
+ 0,
+ 0,
+ 0,
+ 0,
+ 0,
+ Result);
+end;
+
+function IsAdmin: LongBool;
+var
+ TokenHandle : THandle;
+ ReturnLength : DWORD;
+ TokenInformation : PTokenGroups;
+ AdminSid : PSID;
+ Loop : Integer;
+ wv : TOSVersionInfo;
+begin
+ wv.dwOSVersionInfoSize := sizeof(TOSversionInfo);
+ GetVersionEx(wv);
+
+ Result := (wv.dwPlatformId = VER_PLATFORM_WIN32_WINDOWS);
+
+ if(wv.dwPlatformId = VER_PLATFORM_WIN32_NT) then
+ begin
+ TokenHandle := 0;
+ if OpenProcessToken(GetCurrentProcess, TOKEN_QUERY, TokenHandle) then
+ try
+ ReturnLength := 0;
+ GetTokenInformation(TokenHandle, TokenGroups, nil, 0, ReturnLength);
+ TokenInformation := GetMemory(ReturnLength);
+ if Assigned(TokenInformation) then
+ try
+ if GetTokenInformation(TokenHandle, TokenGroups,
+ TokenInformation, ReturnLength, ReturnLength) then
+ begin
+ AdminSid := GetAdminSid;
+ for Loop := 0 to TokenInformation^.GroupCount - 1 do
+ begin
+ if EqualSid(TokenInformation^.Groups[Loop].Sid, AdminSid) then
+ begin
+ Result := True; break;
+ end;
+ end;
+ FreeSid(AdminSid);
+ end;
+ finally
+ FreeMemory(TokenInformation);
+ end;
+ finally
+ CloseHandle(TokenHandle);
+ end;
+ end;
+end;
+
+function WVersion: string;
+var
+ OSInfo: TOSVersionInfo;
+begin
+ Result := '3X';
+ OSInfo.dwOSVersionInfoSize := sizeof(TOSVERSIONINFO);
+ GetVersionEx(OSInfo);
+ case OSInfo.dwPlatformID of
+ VER_PLATFORM_WIN32S: begin
+ Result := '3X';
+ Exit;
+ end;
+ VER_PLATFORM_WIN32_WINDOWS: begin
+ Result := '9X';
+ Exit;
+ end;
+ VER_PLATFORM_WIN32_NT: begin
+ Result := 'NT';
+ Exit;
+ end;
+ end; //case
+end;
Index: oup/releases/0.30a/TFileTypeRegistration/SysUtils.inc
===================================================================
--- oup/releases/0.30a/TFileTypeRegistration/SysUtils.inc (revision 33)
+++ oup/releases/0.30a/TFileTypeRegistration/SysUtils.inc (revision 33)
@@ -0,0 +1,307 @@
+function fileexists(const szFilename: string): boolean;
+var
+ Handle : THandle;
+ FindData : TWin32FindData;
+begin
+ Handle := FindFirstFile(pchar(szFilename),FindData);
+ Result := (Handle <> INVALID_HANDLE_VALUE);
+
+ if(Result) then Windows.FindClose(Handle);
+end;
+
+function ExtractFileDrive(const szFilename: string): string;
+var
+ i : integer;
+begin
+ Result := '';
+ i := length(szFilename);
+ while(i > 0) do
+ begin
+ if(szFileName[i] = ':') then
+ begin
+ Result := copy(szFilename,1,i);
+ break;
+ end;
+
+ dec(i);
+ end;
+end;
+
+function ExtractFilePath(const szFilename: string): string;
+var
+ i : integer;
+begin
+ Result := '';
+ i := length(szFileName);
+ while(i > 0) do
+ begin
+ if(szFileName[i] = ':') or
+ (szFileName[i] = '\') then
+ begin
+ Result := copy(szFileName,1,i);
+ break;
+ end;
+
+ dec(i);
+ end;
+end;
+
+function ExtractFileName(const szFilename: string): string;
+var
+ i : integer;
+begin
+ i := length(szFilename);
+ while(i > 0) do
+ begin
+ if(szFilename[i] = '\') then
+ break;
+
+ dec(i);
+ end;
+
+ Result := copy(szFilename,i + 1,length(szFilename));
+end;
+
+function CutFileExt(const szFilename: string): string;
+var
+ i : integer;
+begin
+ i := length(szFilename);
+ while(i > 0) do
+ begin
+ if(szFilename[i] = '.') then
+ break;
+
+ dec(i);
+ end;
+
+ if(i = 0) then Result := szFilename
+ else Result := copy(szFilename,1,i-1);
+end;
+
+function ChangeFileExt(const szFileName, szNewExt: string): string;
+begin
+ Result := CutFileExt(szFileName);
+
+ if(szNewExt[1] <> '.') then Result := Result + '.' + szNewExt
+ else Result := Result + szNewExt;
+end;
+
+function FileSearch(const Name, DirList: string): string;
+var
+ I, P, L: Integer;
+begin
+ Result := Name;
+ P := 1;
+ L := length(DirList);
+
+ while(true) do begin
+ if(fileexists(Result)) then exit;
+
+ while(P <= L) and (DirList[P] = ';') do inc(P);
+ if(P > L) then break;
+
+ I := P;
+ while(P <= L) and (DirList[P] <> ';') do inc(P);
+
+ Result := copy(DirList,I,P-I);
+ if not(Result[length(Result)] in[':','\']) then
+ Result := Result + '\';
+
+ Result := Result + Name;
+ end;
+
+ Result := '';
+end;
+
+function StrToIntDef(const s: string; const i: integer): integer;
+var
+ code : integer;
+begin
+ Val(s,Result,code); if(code <> 0) then
+ Result := i;
+end;
+
+function IntToStr(const i: integer): string;
+begin
+ Str(i,Result);
+end;
+
+// -----------------------------------------------------------------------------
+
+function Format(fmt: string; params: array of const): string;
+var
+ pdw1,
+ pdw2 : PDWORD;
+ i : integer;
+ pc : PCHAR;
+begin
+ pdw1 := nil;
+
+ if High(params) >= 0 then
+ GetMem(pdw1, (High(params) + 1) * sizeof(Pointer));
+
+ pdw2 := pdw1;
+ for i := 0 to High(params) do
+ begin
+ pdw2^ := PDWORD(@params[i])^;
+ inc(pdw2);
+ end;
+
+ pc := GetMemory(1024);
+ if Assigned(pc) then
+ try
+ SetString(Result, pc, wvsprintf(pc, PCHAR(fmt), PCHAR(pdw1)));
+ finally
+ if (pdw1 <> nil) then FreeMem(pdw1);
+ FreeMem(pc);
+ end
+ else
+ Result := '';
+end;
+
+
+// -----------------------------------------------------------------------------
+
+function UpperCase(const s: string): string;
+var
+ i : integer;
+begin
+ Result := '';
+
+ if(length(s) > 0) then
+ begin
+ SetLength(Result,length(s));
+ for i := 1 to length(s) do
+ Result[i] := UpCase(s[i]);
+ end;
+end;
+
+function LowerCase(const s: string): string;
+var
+ i : integer;
+begin
+ Result := '';
+
+ if(length(s) > 0) then
+ begin
+ SetLength(Result,length(s));
+ for i := 1 to length(s) do
+ case s[i] of
+ 'A'..'Z','Ä','Ö','Ü':
+ Result[i] := CHR(BYTE(s[i]) + 32);
+ else
+ Result[i] := s[i];
+ end;
+ end;
+end;
+
+function LoggedUser: string;
+var
+ dwLen : dword;
+ fTest : boolean;
+begin
+ Result := '';
+ dwLen := MAX_PATH; SetLength(Result,dwLen);
+
+ fTest := GetUserName(@Result[1],dwLen);
+
+ if(not fTest) and (GetLastError = ERROR_MORE_DATA) then begin
+ SetLength(Result,dwLen);
+ fTest := GetUserName(@Result[1],dwLen);
+ end;
+
+ if(fTest) and (Result[1] <> #0) then
+ SetLength(Result,dwLen - 1);
+end;
+
+// -----------------------------------------------------------------------------
+
+//
+// delete files during next reboot (code by sakura)
+//
+function DeleteFileDuringNextSystemBoot(aFileName: string): Boolean;
+var
+ ShortName,
+ winini : string;
+ os : TOSVersionInfo;
+ ts : array of string;
+ f : TextFile;
+ i : integer;
+begin
+ Result := False;
+
+ // get OS version
+ os.dwOSVersionInfoSize := sizeof(TOSVersionInfo);
+ GetVersionEx(os);
+
+ case os.dwPlatformId of
+ // NT systems
+ VER_PLATFORM_WIN32_NT:
+ Result := MoveFileEx(pchar(aFileName),nil,
+ MOVEFILE_REPLACE_EXISTING + MOVEFILE_DELAY_UNTIL_REBOOT);
+ // 9x systems
+ VER_PLATFORM_WIN32_WINDOWS:
+ begin
+ // get Windows folder
+ SetLength(winini,MAX_PATH+1);
+ SetLength(winini,GetWindowsDirectory(@winini[1],MAX_PATH+1));
+
+ if(winini <> '') then begin
+ if(winini[length(winini)] <> '\') then
+ winini := winini + '\';
+ winini := winini + 'wininit.ini';
+
+ // get short name of the given file
+ SetLength(ShortName,MAX_PATH+1);
+ SetLength(ShortName,
+ GetShortPathName(@aFilename[1],@ShortName[1],MAX_PATH+1));
+
+ if(ShortName <> '') then begin
+ // add it to "wininit.ini" to delete
+ // during next reboot
+ SetLength(ts,0);
+
+ {$I-}
+ // get old file´s content
+ AssignFile(f,winini);
+ ReSet(f);
+ if(IoResult = 0) then begin
+ while(not eof(f)) do begin
+ SetLength(ts,length(ts)+1);
+ ReadLn(f,ts[length(ts)-1]);
+
+ if(lstrcmpi('[rename]',pchar(ts[length(ts)-1])) = 0) then begin
+ SetLength(ts,length(ts)+1);
+ ts[length(ts)-1] := 'NUL='+ShortName;
+ end;
+ end;
+ CloseFile(f);
+ end;
+
+ if(length(ts) = 0) then begin
+ SetLength(ts,2);
+ ts[0] := '[rename]';
+ ts[1] := 'NUL='+ShortName;
+ end;
+
+ // re-create
+ ReWrite(f);
+ Result := (IoResult = 0);
+ if(Result) then begin
+ for i := 0 to length(ts) - 1 do
+ WriteLn(f,ts[i]);
+
+ CloseFile(f);
+ end;
+ {$I+}
+
+ SetLength(ts,0);
+ end;
+ end;
+ end;
+ // only 9x and NT are supported
+ else
+ exit;
+ end;
+end;
Index: oup/releases/0.30a/TFileTypeRegistration/demo.txt
===================================================================
--- oup/releases/0.30a/TFileTypeRegistration/demo.txt (revision 33)
+++ oup/releases/0.30a/TFileTypeRegistration/demo.txt (revision 33)
@@ -0,0 +1,34 @@
+uses
+ ftypesAPI;
+
+var
+ ftr : TFileTypeRegistration;
+ s:String;
+
+
+ftr := TFileTypeRegistration.Create;
+if(ftr <> nil) then begin
+ try
+ if(LOWORD(wp) = IDC_CREATEFOO) then begin
+ if(ftr.RegisterType('.foo','FooFile','FOO-File')) then begin
+ ftr.AddHandler('open','notepad.exe "%1"','Öffnen');
+ ftr.AddHandler('print','notepad.exe /p "%1"');
+ ftr.SetDefaultHandler;
+ ftr.AddNewFileSupport('.foo');
+ end;
+ end;
+ if(LOWORD(wp) = IDC_DELPRINTVERB) then begin
+ if(ftr.GetInternalKey('.foo') <> '') then begin
+ ftr.DeleteHandler('print');
+ ftr.SetDefaultHandler('open');
+ end;
+ end;
+ if(LOWORD(wp) = IDC_REMOVEFOO) then begin
+ s := ftr.GetInternalKey('.foo');
+ if(MessageBox(hwndDlg,pchar('Wollen Sie wirklich ".foo" und "' + s + '" entfernen?'), 'Frage',MB_YESNO or MB_DEFBUTTON2 or MB_ICONQUESTION) = ID_YES) then
+ ftr.UnregisterType('.foo');
+ end;
+ finally
+ ftr.Free;
+ end;
+end;
Index: oup/releases/0.30a/TFileTypeRegistration/ftypesAPI.pas
===================================================================
--- oup/releases/0.30a/TFileTypeRegistration/ftypesAPI.pas (revision 33)
+++ oup/releases/0.30a/TFileTypeRegistration/ftypesAPI.pas (revision 33)
@@ -0,0 +1,544 @@
+// -----------------------------------------------------------------------------
+//
+// TFileTypeRegistration-Klasse (Win32-API)
+// Copyright (c) 2004 Mathias Simmack
+//
+// -----------------------------------------------------------------------------
+
+// -- Revision history ---------------------------------------------------------
+//
+// * erste Version
+//
+// -----------------------------------------------------------------------------
+unit ftypesAPI;
+
+interface
+
+uses
+ Windows, ShlObj;
+
+type
+ TFileTypeRegistration = class
+ FRegConnector : HKEY;
+ FExtension,
+ FInternalName : string;
+ FVerb : string;
+ public
+ constructor Create;
+ destructor Destroy; override;
+ function RegisterType(const Extension, InternalName: string;
+ Description: string = ''; IconFile: string = '';
+ IconIndex: integer = -1): boolean;
+ function UnregisterExtension(const Extension: string): boolean;
+ function UnregisterType(const Extension: string): boolean;
+ procedure UpdateShell;
+ function AddHandler(const HandlerVerb, CommandLine: string;
+ HandlerDescription: string = ''): boolean; overload;
+ function DeleteHandler(const HandlerVerb: string): boolean;
+ function SetDefaultHandler: boolean; overload;
+ function SetDefaultHandler(const HandlerVerb: string): boolean; overload;
+ function GetInternalKey(const Extension: string): string;
+ function AddNewFileSupport(const Extension: string): boolean;
+ function RemoveNewFileSupport(const Extension: string): boolean;
+
+ property Extension: string read FExtension;
+ property InternalName: string read FInternalName;
+ property CurrentVerb: string read FVerb;
+ end;
+
+
+implementation
+
+(* *****************************************************************************
+
+ Beispiel #1: Einen neuen Dateityp registrieren
+ ----------------------------------------------
+
+ ftr := TFileTypeRegistration.Create;
+ if(ftr <> nil) then
+ try
+ // die Dateiendung ".foo" registrieren, der interne Schlüssel
+ // lautet "FooFile", eine Beschreibung und eine Symboldatei
+ // sind ebenfalls angegeben
+ if(ftr.RegisterType('.foo','FooFile','FOO Description',
+ 'c:\folder\icon.ico')) then
+ begin
+ // fügt den Handler "open" hinzu und verknüpft ihn mit dem
+ // Programm "foo.exe"
+ ftr.AddHandler('open','"c:\folder\foo.exe" "%1"');
+
+ // setzt den zuletzt benutzten Handler ("open" in dem Fall)
+ // als Standard
+ ftr.SetDefaultHandler;
+ end;
+
+ if(ftr.RegisterType('.foo','ThisIsNotTheFOOKey')) then
+ // Das ist kein Fehler! Obwohl hier der interne Name
+ // "ThisIsNotTheFOOKey" verwendet wird, benutzt die Funktion
+ // intern den bereits vorhandenen Schlüssel "FooFile" (s. oben).
+ begin
+ // zwei neue Handler werden registriert, ...
+ ftr.AddHandler('print','"c:\folder\foo.exe" /p "%1"');
+ ftr.AddHandler('edit','notepad.exe "%1"');
+
+ // ... & dank der überladenen Funktion "SetDefaultHandler"
+ // kann diesmal auch "print" als Standardhandler gesetzt
+ // werden
+ ftr.SetDefaultHandler('print');
+ end;
+ finally
+ ftr.Free;
+ end;
+
+
+ Beispiel #2: Einen neuen Typ mit einem vorhandenen Schlüssel
+ verknüpfen
+ ------------------------------------------------------------
+
+ Das Beispiel registriert die Endung ".foo" auf die gleiche
+ Weise wie Textdateien (.txt). Es wird einfach der interne
+ Schlüsselname ermittelt und für die Endung ".foo" gesetzt
+
+ ftr := TFileTypeRegistration.Create;
+ if(ftr <> nil) then
+ try
+ strInternalTextFileKey := ftr.GetInternalKey('.txt');
+ if(strInternalTextFileKey <> '') then
+ ftr.RegisterType('.foo',strInternalTextFileKey);
+ finally
+ ftr.Free;
+ end;
+
+
+ Beispiel #3: Einen Handler entfernen
+ ------------------------------------
+
+ ftr := TFileTypeRegistration.Create;
+ if(ftr <> nil) then
+ try
+ // den internen Schlüsselnamen des Typs ".foo" ermitteln, ...
+ if(ftr.GetInternalKey('.foo') <> '') then
+ // ... wobei das Ergebnis in dem Fall unwichtig ist, weil
+ // intern auch die Eigenschaft "FInternalName" gesetzt
+ // wird
+ begin
+ // den "print"-Handler entfernen, ...
+ ftr.DeleteHandler('print');
+
+ // ... & den Standardhandler aktualisieren
+ ftr.SetDefaultHandler('open');
+ end;
+ finally
+ ftr.Free;
+ end;
+
+
+ Beispiel #4: Nur eine Dateiendung entfernen
+ -------------------------------------------
+
+ In diesem Fall wird lediglich die Endung ".foo" entfernt. Der
+ evtl. vorhandene interne Schlüssel bleibt bestehen. Das ist
+ für das Beispiel #2 nützlich, wenn die Endung ".foo" entfernt
+ werden soll, intern aber mit den Textdateien verlinkt ist, die
+ ja im Normalfall nicht entfernt werden dürfen/sollten.
+
+ ftr.UnregisterExtension('.foo');
+
+
+ Beispiel #5: Den kompletten Dateityp entfernen
+ ----------------------------------------------
+
+ Dieses Beispiel entfernt dagegen den kompletten Dateityp,
+ inkl. des evtl. vorhandenen internen Schlüssels (vgl. mit
+ Beispiel #4).
+
+ ftr.UnregisterType('.foo');
+
+ Bezogen auf Beispiel #2 wäre das die fatale Lösung, weil dadurch
+ zwar die Endung ".foo" deregistriert wird, gleichzeitig wird
+ aber auch der intern verwendete Schlüssel der Textdateien
+ gelöscht.
+
+ ALSO, VORSICHT!!!
+
+***************************************************************************** *)
+
+
+//
+// Admin-Rechte sind erforderlich (Funktion von NicoDE)
+//
+{$INCLUDE IsAdmin.inc}
+{$INCLUDE SysUtils.inc}
+
+
+// -----------------------------------------------------------------------------
+//
+// Registry
+//
+// -----------------------------------------------------------------------------
+
+function RegWriteSubKeyVal(const parent: HKEY; SubKeyName: string;
+ ValueName, Value: string): boolean;
+var
+ tmp : HKEY;
+begin
+ Result := false;
+ if(parent = INVALID_HANDLE_VALUE) or
+ (SubKeyName = '') then exit;
+
+ if(RegCreateKeyEx(parent,pchar(SubKeyName),0,nil,0,KEY_READ or KEY_WRITE,
+ nil,tmp,nil) = ERROR_SUCCESS) then
+ try
+ Result := (RegSetValueEx(tmp,pchar(ValueName),0,REG_SZ,pchar(Value),
+ length(Value) + 1) = ERROR_SUCCESS);
+ finally
+ RegCloseKey(tmp);
+ end;
+end;
+
+function RegReadSubKeyStr(const parent: HKEY; SubKeyName: string;
+ ValueName: string): string;
+var
+ tmp : HKEY;
+ lpData,
+ dwLen : dword;
+begin
+ Result := '';
+ if(parent = INVALID_HANDLE_VALUE) or
+ (SubKeyName = '') then exit;
+
+ if(RegOpenKeyEx(parent,pchar(SubKeyName),0,KEY_READ,
+ tmp) = ERROR_SUCCESS) then
+ try
+ lpData := REG_NONE;
+ dwLen := 0;
+ if(RegQueryValueEx(tmp,pchar(ValueName),nil,@lpData,nil,
+ @dwLen) = ERROR_SUCCESS) and
+ (lpData in[REG_SZ,REG_EXPAND_SZ]) and
+ (dwLen > 0) then
+ begin
+ SetLength(Result,dwLen);
+
+ if(RegQueryValueEx(tmp,pchar(ValueName),nil,@lpData,
+ @Result[1],@dwLen) = ERROR_SUCCESS) then
+ SetLength(Result,dwLen - 1)
+ else
+ Result := '';
+ end;
+ finally
+ RegCloseKey(tmp);
+ end;
+end;
+
+function RegKeyExists(const parent: HKEY; KeyName: string): boolean;
+var
+ tmp : HKEY;
+begin
+ Result := (RegOpenKeyEx(parent,pchar(KeyName),0,KEY_READ,tmp) =
+ ERROR_SUCCESS);
+ if(Result) then RegCloseKey(tmp);
+end;
+
+function RegDeleteWholeKey(parent: HKEY; KeyName: string): boolean;
+var
+ reg : HKEY;
+ dwSubkeys : dword;
+ dwLen : dword;
+ i : integer;
+ buf : array[0..MAX_PATH]of char;
+begin
+ if(RegOpenKeyEx(parent,pchar(KeyName),0,KEY_READ,reg) = ERROR_SUCCESS) then
+ try
+ if(RegQueryInfoKey(reg,nil,nil,nil,@dwSubKeys,nil,
+ nil,nil,nil,nil,nil,nil) = ERROR_SUCCESS) and
+ (dwSubKeys > 0) then
+ for i := 0 to dwSubKeys - 1 do begin
+ ZeroMemory(@buf,sizeof(buf));
+ dwLen := MAX_PATH;
+
+ if(RegEnumKeyEx(reg,i,buf,dwLen,nil,nil,nil,nil) = ERROR_SUCCESS) and
+ (dwLen > 0) then
+ RegDeleteWholeKey(reg,buf);
+ end;
+ finally
+ RegCloseKey(reg);
+ end;
+
+ Result := (RegDeleteKey(parent,pchar(KeyName)) = ERROR_SUCCESS);
+end;
+
+
+// -----------------------------------------------------------------------------
+//
+// TFileTypeRegistration-Klasse
+//
+// -----------------------------------------------------------------------------
+
+constructor TFileTypeRegistration.Create;
+var
+ key: HKEY;
+ sub: PChar;
+begin
+ FExtension := '';
+ FInternalName := '';
+ FVerb := '';
+
+ // Zugriff auf die Registry, & HKEY_CLASSES_ROOT
+ // als Root setzen
+ if(WVersion='9X') or IsAdmin then begin
+ key:=HKEY_CLASSES_ROOT;
+ sub:=nil;
+ end else begin
+ key:=HKEY_CURRENT_USER;
+ sub:=PChar('SOFTWARE\Classes');
+ end;
+
+ if RegOpenKeyEx(key,sub,0,KEY_ALL_ACCESS, FRegConnector) <> ERROR_SUCCESS then
+ FRegConnector := INVALID_HANDLE_VALUE;
+end;
+
+destructor TFileTypeRegistration.Destroy;
+begin
+ if(FRegConnector <> INVALID_HANDLE_VALUE) then
+ RegCloseKey(FRegConnector);
+end;
+
+function TFileTypeRegistration.RegisterType(const Extension,
+ InternalName: string; Description: string = ''; IconFile: string = '';
+ IconIndex: integer = -1): boolean;
+var
+ strDummy : string;
+begin
+ // Standardergebnis
+ Result := false;
+ if(FRegConnector = INVALID_HANDLE_VALUE) or
+ (Extension = '') or
+ (Extension[1] <> '.') then exit;
+
+ // ist dieser Typ evtl. schon registriert?
+ strDummy := self.GetInternalKey(Extension);
+
+ // Nein. :o)
+ if(strDummy = '') then strDummy := InternalName;
+
+ // den Schlüssel mit der Dateiendung anlegen oder aktualisieren
+ Result := RegWriteSubKeyVal(FRegConnector,Extension,'',strDummy);
+ if(not Result) then exit;
+
+ // den internen Schlüssel öffnen
+ if(Result) then
+ begin
+ // Beschreibung anlegen
+ if(Description <> '') then
+ RegWriteSubKeyVal(FRegConnector,strDummy,'',Description);
+
+ // Symbol zuweisen (Datei muss existieren!)
+ if(IconFile <> '') and
+ (fileexists(IconFile)) then
+ begin
+ if(IconIndex <> -1) then
+ RegWriteSubKeyVal(FRegConnector,strDummy + '\DefaultIcon',
+ '',Format('%s,%d',[IconFile,IconIndex]))
+ else
+ RegWriteSubKeyVal(FRegConnector,strDummy + '\DefaultIcon',
+ '',IconFile);
+ end;
+ end;
+
+ // Systemsymbole aktualisieren
+ self.UpdateShell;
+
+ // Properties aktualisieren
+ if(Result) then
+ begin
+ FExtension := Extension;
+ FInternalName := strDummy;
+ end;
+end;
+
+function TFileTypeRegistration.UnregisterExtension(const Extension: string):
+ boolean;
+begin
+ Result := false;
+ if(FRegConnector = INVALID_HANDLE_VALUE) or
+ (Extension = '') or
+ (Extension[1] <> '.') then exit;
+
+ // die Endung entfernen
+ Result := (RegKeyExists(FRegConnector,Extension)) and
+ (RegDeleteWholeKey(FRegConnector,Extension));
+
+ // Systemsymbole aktualisieren
+ self.UpdateShell;
+end;
+
+function TFileTypeRegistration.UnregisterType(const Extension: string):
+ boolean;
+var
+ strDummy : string;
+begin
+ Result := false;
+ if(FRegConnector = INVALID_HANDLE_VALUE) or
+ (Extension = '') or
+ (Extension[1] <> '.') then exit;
+
+ // den internen Namen der Endung ermitteln
+ strDummy := self.GetInternalKey(Extension);
+
+ // die Endung entfernen (s. "UnregisterExtension"), ...
+ Result := (self.UnregisterExtension(Extension)) and
+ // ... & den internen Schlüssel löschen
+ (strDummy <> '') and
+ (RegKeyExists(FRegConnector,strDummy)) and
+ (RegDeleteWholeKey(FRegConnector,strDummy));
+
+ // Systemsymbole aktualisieren
+ self.UpdateShell;
+end;
+
+procedure TFileTypeRegistration.UpdateShell;
+begin
+ SHChangeNotify(SHCNE_ASSOCCHANGED,SHCNF_IDLIST,nil,nil);
+end;
+
+
+const
+ ShellKey = '%s\shell\%s';
+
+function TFileTypeRegistration.AddHandler(const HandlerVerb,
+ CommandLine: string; HandlerDescription: string = ''): boolean;
+begin
+ // Standardergebnis
+ Result := false;
+ if(FRegConnector = INVALID_HANDLE_VALUE) or
+ (FInternalName = '') or
+ (HandlerVerb = '') or
+ (CommandLine = '') then exit;
+
+ // der interne Schlüssel muss existieren
+ if(RegKeyExists(FRegConnector,FInternalName)) then
+ begin
+ // den Handler (= Verb) erzeugen
+ Result := RegWriteSubKeyVal(FRegConnector,
+ Format(ShellKey + '\command',[FInternalName,HandlerVerb]),
+ '',
+ CommandLine);
+
+ // ggf. Beschreibung für Handler setzen
+ if(HandlerDescription <> '') then
+ RegWriteSubKeyVal(FRegConnector,
+ Format(ShellKey,[FInternalName,HandlerVerb]),
+ '',
+ HandlerDescription);
+ end;
+
+ // interne Eigenschaft anpassen (für "SetDefaultHandler")
+ if(Result) then
+ FVerb := HandlerVerb;
+end;
+
+function TFileTypeRegistration.DeleteHandler(const HandlerVerb: string):
+ boolean;
+begin
+ // Standardergebnis
+ Result := false;
+ if(FRegConnector = INVALID_HANDLE_VALUE) or
+ (FInternalName = '') or
+ (HandlerVerb = '') then exit;
+
+ // Handlerschlüssel entfernen (sofern vorhanden)
+ Result :=
+ (RegKeyExists(FRegConnector,
+ Format(ShellKey,[FInternalName,HandlerVerb]))) and
+ (RegDeleteWholeKey(FRegConnector,
+ Format(ShellKey,[FInternalName,HandlerVerb])));
+end;
+
+function TFileTypeRegistration.SetDefaultHandler: boolean;
+begin
+ if(FInternalName <> '') and (FVerb <> '') then
+ Result := self.SetDefaultHandler(FVerb)
+ else
+ Result := false;
+end;
+
+function TFileTypeRegistration.SetDefaultHandler(const HandlerVerb: string):
+ boolean;
+begin
+ Result := false;
+ if(FRegConnector = INVALID_HANDLE_VALUE) or
+ (FInternalName = '') or
+ (HandlerVerb = '') then exit;
+
+ // interner Schlüssel muss existieren, ...
+ if(RegKeyExists(FRegConnector,FInternalName)) and
+ // ... & Handler muss existieren, ...
+ (RegKeyExists(FRegConnector,
+ Format(ShellKey,[FInternalName,HandlerVerb]))) then
+ begin
+ // ... dann den Handler als Standard eintragen
+ Result := RegWriteSubKeyVal(FRegConnector,FInternalName + '\shell',
+ '',HandlerVerb);
+ end;
+end;
+
+function TFileTypeRegistration.GetInternalKey(const Extension: string): string;
+begin
+ if(FRegConnector = INVALID_HANDLE_VALUE) or
+ (Extension = '') or
+ (Extension[1] <> '.') then exit;
+
+ // einen evtl. eingestellten internen Namen zurücksetzen
+ FInternalName := '';
+
+ // den Schlüssel der Dateiendung öffnen, ...
+ if(RegKeyExists(FRegConnector,Extension)) then
+ FInternalName := RegReadSubKeyStr(FRegConnector,Extension,'');
+
+ // ... als Funktionsergebnis zurückliefern
+ if(not RegKeyExists(FRegConnector,FInternalName)) then
+ FInternalName := '';
+
+ Result := FInternalName;
+end;
+
+
+function TFileTypeRegistration.AddNewFileSupport(const Extension: string):
+ boolean;
+var
+ Description : string;
+begin
+ Result := false;
+ if(FRegConnector = INVALID_HANDLE_VALUE) or
+ (Extension = '') or
+ (Extension[1] <> '.') then exit;
+
+ // interne Beschreibung des Typs ermitteln
+ if(self.GetInternalKey(Extension) <> '') then
+ Description := RegReadSubKeyStr(FRegConnector,FInternalName,'')
+ else
+ Description := '';
+
+ // die Beschreibung darf keine Leerzeichen enthalten, weil sie
+ // als Referenz für den neuen Dateinamen verwendet wird, ...
+ if(pos(#32,Description) > 0) or
+ // ... & sie darf auch nicht leer sein
+ (Description = '') then exit;
+
+ Result := (RegKeyExists(FRegConnector,Extension)) and
+ (RegWriteSubKeyVal(FRegConnector,Extension + '\ShellNew','NullFile',''));
+end;
+
+function TFileTypeRegistration.RemoveNewFileSupport(const Extension: string):
+ boolean;
+begin
+ Result := false;
+ if(FRegConnector = INVALID_HANDLE_VALUE) or
+ (Extension = '') or
+ (Extension[1] <> '.') then exit;
+
+ Result := (RegKeyExists(FRegConnector,Extension + '\ShellNew')) and
+ (RegDeleteWholeKey(FRegConnector,Extension + '\ShellNew'));
+end;
+
+end.
Index: oup/releases/0.30a/Unit10_leveldb.dfm
===================================================================
--- oup/releases/0.30a/Unit10_leveldb.dfm (revision 33)
+++ oup/releases/0.30a/Unit10_leveldb.dfm (revision 33)
@@ -0,0 +1,61 @@
+object Form10: TForm10
+ Left = 0
+ Top = 0
+ BorderStyle = bsNone
+ Caption = 'Creating DB'
+ ClientHeight = 90
+ ClientWidth = 401
+ Color = clBtnFace
+ Font.Charset = DEFAULT_CHARSET
+ Font.Color = clWindowText
+ Font.Height = -11
+ Font.Name = 'Tahoma'
+ Font.Style = []
+ OldCreateOrder = False
+ Position = poScreenCenter
+ PixelsPerInch = 96
+ TextHeight = 13
+ object group_progress: TGroupBox
+ Left = 0
+ Top = 0
+ Width = 400
+ Height = 89
+ Caption = 'Progress ...'
+ TabOrder = 0
+ object lbl_progress: TLabel
+ Left = 2
+ Top = 32
+ Width = 396
+ Height = 17
+ Align = alTop
+ AutoSize = False
+ end
+ object lbl_estimation: TLabel
+ Left = 2
+ Top = 49
+ Width = 396
+ Height = 17
+ Align = alTop
+ AutoSize = False
+ Caption = 'Estimated finishing time:'
+ end
+ object progress: TProgressBar
+ Left = 2
+ Top = 15
+ Width = 396
+ Height = 17
+ Align = alTop
+ Smooth = True
+ TabOrder = 0
+ end
+ object btn_abortok: TButton
+ Left = 3
+ Top = 64
+ Width = 60
+ Height = 22
+ Caption = 'Abort...'
+ TabOrder = 1
+ OnClick = btn_abortokClick
+ end
+ end
+end
Index: oup/releases/0.30a/Unit10_leveldb.pas
===================================================================
--- oup/releases/0.30a/Unit10_leveldb.pas (revision 33)
+++ oup/releases/0.30a/Unit10_leveldb.pas (revision 33)
@@ -0,0 +1,957 @@
+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;
+ IF dat_os_mac THEN
+ Query.SQL.Text:='INSERT INTO globals (name,value) VALUES ("os","MAC");'
+ ELSE
+ Query.SQL.Text:='INSERT INTO globals (name,value) VALUES ("os","PC");';
+ 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;
+}begin 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: oup/releases/0.30a/Unit11_extractor.dfm
===================================================================
--- oup/releases/0.30a/Unit11_extractor.dfm (revision 33)
+++ oup/releases/0.30a/Unit11_extractor.dfm (revision 33)
@@ -0,0 +1,258 @@
+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: oup/releases/0.30a/Unit11_extractor.pas
===================================================================
--- oup/releases/0.30a/Unit11_extractor.pas (revision 33)
+++ oup/releases/0.30a/Unit11_extractor.pas (revision 33)
@@ -0,0 +1,242 @@
+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, Unit15_Classes;
+
+
+PROCEDURE TForm11.Recreatelist;
+ VAR
+ i:LongWord;
+ exts:TStringArray;
+ BEGIN
+ combo_extension.Items.Clear;
+ combo_extension.Items.Add('_All files_ ('+IntToStr(OniDataConnection.GetFilesCount)+')');
+ exts:=OniDataConnection.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:TStringArray;
+ 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:=OniDataConnection.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(OniDataConnection.GetFileIDByName(list.Items.Strings[list.ItemIndex]),ExtractFileName(saved.FileName),settings,ExtractFileDir(saved.FileName));
+ END ELSE BEGIN
+ ExportFile(OniDataConnection.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(OniDataConnection.GetFileIDByName(list.Items.Strings[list.ItemIndex]),ExtractFileName(saved.FileName),settings,ExtractFileDir(saved.FileName));
+ END ELSE BEGIN
+ ExportFile(OniDataConnection.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: oup/releases/0.30a/Unit12_ValueEdit.dfm
===================================================================
--- oup/releases/0.30a/Unit12_ValueEdit.dfm (revision 33)
+++ oup/releases/0.30a/Unit12_ValueEdit.dfm (revision 33)
@@ -0,0 +1,157 @@
+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: oup/releases/0.30a/Unit12_ValueEdit.pas
===================================================================
--- oup/releases/0.30a/Unit12_ValueEdit.pas (revision 33)
+++ oup/releases/0.30a/Unit12_ValueEdit.pas (revision 33)
@@ -0,0 +1,119 @@
+UNIT Unit12_ValueEdit;
+INTERFACE
+USES
+ Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
+ Dialogs, StdCtrls, CrossEdit, Math;
+TYPE
+ TForm12 = Class(TForm)
+ group: TGroupBox;
+ btn_ok: TButton;
+ btn_cancel: TButton;
+ lbl_current: TLabel;
+ edit_current: TEdit;
+ lbl_new: TLabel;
+ lbl_offset: TLabel;
+ lbl_datatype: TLabel;
+ edit_offset: TEdit;
+ edit_datatype: TEdit;
+ edit_new: TCrossEdit;
+ PROCEDURE btn_cancelClick(Sender: TObject);
+ PROCEDURE btn_okClick(Sender: TObject);
+ PROCEDURE MakeVarInput(objectname:String; offset:LongWord; datatype:Word; current:String; caller:TObject);
+ PRIVATE
+ PUBLIC
+ END;
+
+VAR
+ Form12: TForm12;
+
+
+IMPLEMENTATION
+USES Unit8_binedit, Unit13_rawedit,Unit9_data_structures, Unit1_main;
+{$R *.dfm}
+VAR
+ caller_win_dat:TForm8;
+ caller_win_raw:TForm13;
+ _datatype:Word;
+ _offset:LongWord;
+
+
+PROCEDURE TForm12.MakeVarInput(objectname:String; offset:LongWord; datatype:Word; current:String; caller:TObject);
+ BEGIN
+ caller_win_dat:=NIL;
+ caller_win_raw:=NIL;
+ IF Pos('rawedit',TComponent(caller).Name)>0 THEN
+ caller_win_raw:=TForm13(caller)
+ ELSE
+ caller_win_dat:=TForm8(caller);
+ Form1.Enabled:=False;
+ Self.Visible:=True;
+ group.Caption:='Edit value';
+ _datatype:=datatype;
+ _offset:=offset;
+ IF Length(objectname)>0 THEN group.Caption:=group.Caption+' for '+objectname;
+ edit_offset.Text:='0x'+IntToHex(offset,8);
+ edit_datatype.Text:=GetDataType(datatype);
+ edit_current.Text:=current;
+ edit_new.EditType:=etString;
+ edit_new.Text:='';
+ edit_new.LimitCheck:=False;
+ edit_new.MaxLength:=0;
+ edit_new.Max:=0;
+ edit_new.BorderStyle:=bsSingle;
+ Form12.Width:=300;
+ CASE datatype OF
+ 1..4: BEGIN
+ edit_new.EditType:=etUnsignedInt;
+ edit_new.LimitCheck:=True;
+ edit_new.Max:=Int(Power(256,datatype))-1;
+ END;
+ 5..8: BEGIN
+ edit_new.MaxLength:=2*(datatype-4);
+ edit_new.EditType:=etHex;
+ END;
+ 9: BEGIN
+ edit_new.EditType:=etFloat;
+ edit_new.LimitCheck:=False;
+ END;
+ 10: BEGIN
+ edit_new.EditType:=etBinary;
+ edit_new.LimitCheck:=False;
+ edit_new.MaxLength:=8;
+ END;
+ 13..16: BEGIN
+ Exit;
+ edit_new.EditType:=etInteger;
+ edit_new.LimitCheck:=True;
+ edit_new.Max:=Int((Power(256,datatype-13)) / 2)-1;
+ edit_new.Min:=1-Int((Power(256,datatype-13)) / 2)-1;
+ END;
+ 10000..65535: BEGIN
+ edit_new.EditType:=etString;
+ edit_new.LimitCheck:=False;
+ edit_new.MaxLength:=datatype-10000;
+ Form12.Width:=700;
+ END;
+ END;
+ edit_new.SetFocus;
+ edit_new.SelectAll;
+ END;
+
+PROCEDURE TForm12.btn_okClick(Sender: TObject);
+ BEGIN
+ IF NOT edit_new.NoValidValue THEN BEGIN
+ Form1.Enabled:=True;
+ Self.Visible:=False;
+ IF caller_win_dat=NIL THEN
+ caller_win_raw.SetNewValue(_datatype,_offset,edit_new.Text)
+ ELSE
+ caller_win_dat.SetNewValue(_datatype,_offset,edit_new.Text);
+ END;
+ END;
+
+PROCEDURE TForm12.btn_cancelClick(Sender: TObject);
+ BEGIN
+ Form1.Enabled:=True;
+ Self.Visible:=False;
+ END;
+
+END.
Index: oup/releases/0.30a/Unit13_rawedit.dfm
===================================================================
--- oup/releases/0.30a/Unit13_rawedit.dfm (revision 33)
+++ oup/releases/0.30a/Unit13_rawedit.dfm (revision 33)
@@ -0,0 +1,324 @@
+object Form13: TForm13
+ Left = 0
+ Top = 0
+ BorderIcons = [biSystemMenu, biMaximize]
+ Caption = 'Binary .raw-Editor'
+ ClientHeight = 640
+ ClientWidth = 642
+ Color = clBtnFace
+ Font.Charset = DEFAULT_CHARSET
+ Font.Color = clWindowText
+ Font.Height = -11
+ Font.Name = 'Tahoma'
+ Font.Style = []
+ FormStyle = fsMDIChild
+ KeyPreview = True
+ OldCreateOrder = False
+ Visible = True
+ WindowState = wsMaximized
+ OnActivate = FormActivate
+ OnClose = FormClose
+ OnCloseQuery = FormCloseQuery
+ OnCreate = FormCreate
+ OnKeyUp = FormKeyUp
+ OnResize = FormResize
+ PixelsPerInch = 96
+ TextHeight = 13
+ object Splitter1: TSplitter
+ Left = 150
+ Top = 0
+ Width = 9
+ Height = 640
+ AutoSnap = False
+ Beveled = True
+ MinSize = 150
+ end
+ object panel_data: TPanel
+ Left = 159
+ Top = 0
+ Width = 483
+ Height = 640
+ Align = alClient
+ BevelOuter = bvNone
+ TabOrder = 0
+ OnResize = panel_dataResize
+ object Splitter2: TSplitter
+ Left = 0
+ Top = 209
+ Width = 483
+ Height = 9
+ Cursor = crVSplit
+ Align = alTop
+ AutoSnap = False
+ Beveled = True
+ MinSize = 40
+ end
+ object Splitter3: TSplitter
+ Left = 0
+ Top = 592
+ Width = 483
+ Height = 8
+ Cursor = crVSplit
+ Align = alBottom
+ AutoSnap = False
+ Beveled = True
+ MinSize = 40
+ end
+ object hex: TMPHexEditor
+ Left = 0
+ Top = 0
+ Width = 483
+ Height = 209
+ Cursor = crIBeam
+ Align = alTop
+ Font.Charset = DEFAULT_CHARSET
+ Font.Color = clWindowText
+ Font.Height = -16
+ Font.Name = 'Courier'
+ Font.Style = []
+ OnKeyUp = hexKeyUp
+ ParentFont = False
+ TabOrder = 0
+ BytesPerRow = 16
+ Translation = tkASCII
+ OffsetFormat = '6!10:0x|'
+ Colors.Background = clWindow
+ Colors.ChangedBackground = clWindow
+ Colors.ChangedText = clRed
+ Colors.CursorFrame = clNavy
+ Colors.Offset = clBlack
+ Colors.OddColumn = clBlue
+ Colors.EvenColumn = clNavy
+ Colors.CurrentOffsetBackground = clBtnShadow
+ Colors.OffsetBackGround = clBtnFace
+ Colors.CurrentOffset = clBtnHighlight
+ Colors.Grid = clBtnFace
+ Colors.NonFocusCursorFrame = clAqua
+ Colors.ActiveFieldBackground = clWindow
+ FocusFrame = True
+ NoSizeChange = True
+ AllowInsertMode = False
+ DrawGridLines = False
+ Version = 'May 23, 2005; '#169' markus stephany, vcl[at]mirkes[dot]de'
+ OnChange = hexChange
+ ShowPositionIfNotFocused = True
+ OnSelectionChanged = hexSelectionChanged
+ end
+ object structs: TWrapGrid
+ Left = 0
+ Top = 600
+ Width = 483
+ Height = 40
+ Align = alBottom
+ ColCount = 1
+ DefaultColWidth = 80
+ DefaultRowHeight = 18
+ Enabled = False
+ FixedCols = 0
+ RowCount = 1
+ FixedRows = 0
+ Options = [goFixedVertLine, goFixedHorzLine, goVertLine, goHorzLine, goColSizing]
+ TabOrder = 1
+ OnClick = structsClick
+ OnDblClick = structsDblClick
+ end
+ object value_viewer: TWrapGrid
+ Left = 0
+ Top = 218
+ Width = 483
+ Height = 374
+ Align = alClient
+ ColCount = 1
+ DefaultColWidth = 80
+ DefaultRowHeight = 18
+ FixedCols = 0
+ RowCount = 8
+ FixedRows = 0
+ Options = [goFixedVertLine, goFixedHorzLine, goVertLine, goHorzLine, goColSizing]
+ PopupMenu = value_viewer_context
+ TabOrder = 2
+ OnDblClick = value_viewerDblClick
+ OnMouseDown = value_viewerMouseDown
+ end
+ end
+ object panel_files: TPanel
+ Left = 0
+ Top = 0
+ Width = 150
+ Height = 640
+ Align = alLeft
+ BevelOuter = bvNone
+ TabOrder = 1
+ object Splitter4: TSplitter
+ Left = 0
+ Top = 442
+ Width = 150
+ Height = 9
+ Cursor = crVSplit
+ Align = alBottom
+ AutoSnap = False
+ Beveled = True
+ MinSize = 150
+ end
+ object panel_imexport: TPanel
+ Left = 0
+ Top = 580
+ Width = 150
+ Height = 60
+ Align = alBottom
+ BevelOuter = bvNone
+ TabOrder = 0
+ OnResize = panel_imexportResize
+ object btn_export: TButton
+ Left = 4
+ Top = 4
+ Width = 142
+ Height = 25
+ Caption = 'Export to file...'
+ TabOrder = 0
+ OnClick = btn_exportClick
+ end
+ object btn_import: TButton
+ Left = 4
+ Top = 32
+ Width = 142
+ Height = 25
+ Caption = 'Import from file...'
+ TabOrder = 1
+ OnClick = btn_importClick
+ end
+ end
+ object group_file: TGroupBox
+ Left = 0
+ Top = 0
+ Width = 150
+ Height = 442
+ Align = alClient
+ Caption = '1. Select file'
+ TabOrder = 1
+ object list: TListBox
+ Left = 2
+ Top = 15
+ Width = 146
+ Height = 337
+ Align = alClient
+ ItemHeight = 13
+ TabOrder = 0
+ OnClick = listClick
+ end
+ object panel_extension: TPanel
+ Left = 2
+ Top = 352
+ Width = 146
+ Height = 88
+ Align = alBottom
+ BevelOuter = bvNone
+ TabOrder = 1
+ OnResize = panel_extensionResize
+ object lbl_filter: TLabel
+ Left = 2
+ Top = 46
+ Width = 100
+ Height = 17
+ AutoSize = False
+ Caption = 'Filter by &extension:'
+ FocusControl = combo_extension
+ end
+ object combo_extension: TComboBox
+ Left = 2
+ Top = 60
+ Width = 145
+ Height = 21
+ Style = csDropDownList
+ DropDownCount = 12
+ Font.Charset = DEFAULT_CHARSET
+ Font.Color = clWindowText
+ Font.Height = -11
+ Font.Name = 'Tahoma'
+ Font.Style = []
+ ItemHeight = 0
+ ParentFont = False
+ Sorted = True
+ TabOrder = 2
+ OnClick = combo_extensionClick
+ 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
+ end
+ object GroupBox1: TGroupBox
+ Left = 0
+ Top = 451
+ Width = 150
+ Height = 129
+ Align = alBottom
+ Caption = '2. Select .dat-link-offset'
+ TabOrder = 2
+ object list_offset: TListBox
+ Left = 2
+ Top = 15
+ Width = 146
+ Height = 112
+ Align = alClient
+ ItemHeight = 13
+ TabOrder = 0
+ OnClick = list_offsetClick
+ end
+ end
+ end
+ object value_viewer_context: TPopupMenu
+ AutoHotkeys = maManual
+ OnPopup = value_viewer_contextPopup
+ Left = 368
+ Top = 264
+ object value_viewer_context_copy: TMenuItem
+ Caption = 'Copy to &clipboard'
+ OnClick = value_viewer_context_copyClick
+ end
+ object value_viewer_context_copyasdec: TMenuItem
+ Caption = 'Copy to clipboard (as &dec)'
+ OnClick = value_viewer_context_copyClick
+ end
+ object value_viewer_context_copyasfloat: TMenuItem
+ Caption = 'Copy to clipboard (as &float)'
+ OnClick = value_viewer_context_copyClick
+ end
+ object value_viewer_context_copyasbitset: TMenuItem
+ Caption = 'Copy to clipboard (as &bitset)'
+ OnClick = value_viewer_context_copyClick
+ end
+ object value_viewer_context_copyasstring: TMenuItem
+ Caption = 'Copy to clipboard (as &string)'
+ OnClick = value_viewer_context_copyClick
+ end
+ object value_viewer_context_copyashex: TMenuItem
+ Caption = 'Copy to clipboard (as &hex)'
+ OnClick = value_viewer_context_copyClick
+ end
+ end
+ object opend: TOpenDialog
+ Options = [ofPathMustExist, ofFileMustExist, ofEnableSizing]
+ Left = 120
+ Top = 584
+ end
+ object saved: TSaveDialog
+ Options = [ofOverwritePrompt, ofPathMustExist, ofEnableSizing]
+ Left = 120
+ Top = 608
+ end
+end
Index: oup/releases/0.30a/Unit13_rawedit.pas
===================================================================
--- oup/releases/0.30a/Unit13_rawedit.pas (revision 33)
+++ oup/releases/0.30a/Unit13_rawedit.pas (revision 33)
@@ -0,0 +1,810 @@
+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, Unit15_Classes,
+ 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 OniDataConnection.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);
+ OniDataConnection.LoadRawFile(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:TStringArray;
+ count:LongWord;
+ BEGIN
+ combo_extension.Items.Clear;
+ combo_extension.Items.Add('_All files_ ('{+IntToStr(dat_header.Files)}+')');
+ exts:=OniDataConnection.GetExtensionsList;
+ FOR i:=0 TO High(RawListHandlers) DO BEGIN
+ count:=Length(OniDataConnection.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:TStringArray;
+ 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:=OniDataConnection.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:=OniDataConnection.GetFileIDByName(list.Items.Strings[list.ItemIndex]);
+ list_offset.Enabled:=True;
+ IF OniDataConnection.GetFileInfo(fileid).size>0 THEN BEGIN
+ offsets:=OniDataConnection.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(OniDataConnection.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 '+OniDataConnection.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;
+ OniDataConnection.UpdateRawFile(fileid_opened,dat_offset_opened,Length(data),@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 (*.'+OniDataConnection.GetFileInfo(fileid).Extension+')|*.'+OniDataConnection.GetFileInfo(fileid).Extension+'|All files|*.*';
+ saved.DefaultExt:=OniDataConnection.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 (*.'+OniDataConnection.GetFileInfo(fileid).Extension+')|*.'+OniDataConnection.GetFileInfo(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: oup/releases/0.30a/Unit14_settings.dfm
===================================================================
--- oup/releases/0.30a/Unit14_settings.dfm (revision 33)
+++ oup/releases/0.30a/Unit14_settings.dfm (revision 33)
@@ -0,0 +1,75 @@
+object Form14: TForm14
+ Left = 0
+ Top = 0
+ BorderStyle = bsToolWindow
+ Caption = 'Settings'
+ ClientHeight = 350
+ ClientWidth = 250
+ Color = clBtnFace
+ Font.Charset = DEFAULT_CHARSET
+ Font.Color = clWindowText
+ Font.Height = -11
+ Font.Name = 'Tahoma'
+ Font.Style = []
+ OldCreateOrder = False
+ Position = poMainFormCenter
+ OnCloseQuery = FormCloseQuery
+ OnShow = FormShow
+ PixelsPerInch = 96
+ TextHeight = 13
+ object check_filesashex: TCheckBox
+ Left = 8
+ Top = 8
+ Width = 145
+ Height = 17
+ Caption = 'Show filenumbers as Hex'
+ TabOrder = 0
+ end
+ object btn_ok: TButton
+ Left = 8
+ Top = 319
+ Width = 57
+ Height = 23
+ Caption = 'OK'
+ Default = True
+ TabOrder = 1
+ OnClick = btn_okClick
+ end
+ object btn_cancel: TButton
+ Left = 120
+ Top = 319
+ Width = 57
+ Height = 23
+ Cancel = True
+ Caption = 'Cancel'
+ TabOrder = 2
+ OnClick = btn_cancelClick
+ end
+ object btn_register_oldb: TButton
+ Left = 8
+ Top = 128
+ Width = 169
+ Height = 25
+ Caption = 'Register .oldb files with OUP'
+ TabOrder = 3
+ OnClick = btn_register_oldbClick
+ end
+ object btn_register_opf: TButton
+ Left = 8
+ Top = 159
+ Width = 169
+ Height = 25
+ Caption = 'Register .opf files with OUP'
+ TabOrder = 4
+ OnClick = btn_register_opfClick
+ end
+ object btn_register_dat: TButton
+ Left = 8
+ Top = 97
+ Width = 169
+ Height = 25
+ Caption = 'Register .dat files with OUP'
+ TabOrder = 5
+ OnClick = btn_register_datClick
+ end
+end
Index: oup/releases/0.30a/Unit14_settings.pas
===================================================================
--- oup/releases/0.30a/Unit14_settings.pas (revision 33)
+++ oup/releases/0.30a/Unit14_settings.pas (revision 33)
@@ -0,0 +1,155 @@
+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: oup/releases/0.30a/Unit15_Classes.pas
===================================================================
--- oup/releases/0.30a/Unit15_Classes.pas (revision 33)
+++ oup/releases/0.30a/Unit15_Classes.pas (revision 33)
@@ -0,0 +1,874 @@
+unit Unit15_Classes;
+interface
+uses Unit3_data, Unit9_data_structures, Classes, SysUtils, StrUtils, Dialogs, ABSDecUtil, ABSMain, DB;
+
+
+type
+ TOniData = class
+ private
+ FFileName:String;
+ FLevelInfo:TLevelInfo;
+ FBackend:Integer;
+ Fos_mac:Boolean;
+ protected
+ public
+ property FileName:String read FFileName write FFileName;
+ property Backend:Integer read FBackend write FBackend;
+ property OSisMac:Boolean read Fos_mac write Fos_mac;
+
+ constructor Create(filename:String; var Result:Boolean); virtual; abstract;
+ procedure Close; virtual; abstract;
+
+ function GetFileInfo(fileid:LongWord):TFileInfo; virtual; abstract;
+ function GetFilesList(ext:String; pattern:String; NoEmptyFiles:Boolean):TStringArray; virtual; abstract;
+ function GetFilesCount:LongWord; virtual; abstract;
+ function GetExtensionsList:TStringArray; virtual; abstract;
+ function GetFileIDByName(name:String):LongWord;
+
+ function LoadDatFile(fileid:LongWord):Tdata; virtual; abstract;
+ procedure UpdateDatFile(fileid:LongWord; data:Tdata); virtual; abstract;
+ procedure LoadDatFilePart(fileid,offset,size:LongWord; target:Pointer); virtual; abstract;
+ procedure UpdateDatFilePart(fileid,offset,size:LongWord; target:Pointer); virtual; abstract;
+
+ function GetRawList(fileid:LongWord):TRawList; virtual; abstract;
+ function GetRawInfo(fileid,dat_offset:LongWord):TRawInfo;
+ procedure LoadRawFile(fileid,dat_offset:LongWord; target:Pointer); virtual; abstract;
+ procedure UpdateRawFile(fileid,dat_offset:LongWord; size:LongWord; target:Pointer); virtual; abstract;
+ procedure LoadRawFilePart(fileid,dat_offset:LongWord; offset,size:LongWord; target:Pointer); virtual; abstract;
+ procedure UpdateRawFilePart(fileid,dat_offset:LongWord; offset,size:LongWord; target:Pointer); virtual; abstract;
+ function AppendRawFile(loc_sep:Boolean; size:LongWord; target:Pointer):LongWord; virtual; abstract;//Returns new Address
+ published
+ end;
+
+ TOniDataDat = class(TOniData)
+ private
+ Fdat_header:THeader;
+ Fdat_filesmap:TFilesMap;
+ Fdat_files:TFiles;
+ Fdat_namedfilesmap:TNamedFilesMap;
+ Fdat_extensionsmap:TExtensionsMap;
+ protected
+ public
+ constructor Create(DatFilename:String; var Result:Boolean); override;
+ procedure Close; override;
+
+ function GetFileInfo(fileid:LongWord):TFileInfo; override;
+ function GetFilesList(ext:String; pattern:String; NoEmptyFiles:Boolean):TStringArray; override;
+ function GetFilesCount:LongWord; override;
+ function GetExtensionsList:TStringArray; override;
+
+ function LoadDatFile(fileid:LongWord):Tdata; override;
+ procedure UpdateDatFile(fileid:LongWord; data:Tdata); override;
+ procedure LoadDatFilePart(fileid,offset,size:LongWord; target:Pointer); override;
+ procedure UpdateDatFilePart(fileid,offset,size:LongWord; target:Pointer); override;
+
+ procedure LoadRawOffset(loc_sep:Boolean; raw_addr,size:LongWord; target:Pointer);
+ function GetRawList(fileid:LongWord):TRawList; override;
+ procedure LoadRawFile(fileid,dat_offset:LongWord; target:Pointer); override;
+ procedure UpdateRawFile(fileid,dat_offset:LongWord; size:LongWord; target:Pointer); override;
+ procedure LoadRawFilePart(fileid,dat_offset:LongWord; offset,size:LongWord; target:Pointer); override;
+ procedure UpdateRawFilePart(fileid,dat_offset:LongWord; offset,size:LongWord; target:Pointer); override;
+ function AppendRawFile(loc_sep:Boolean; size:LongWord; target:Pointer):LongWord; override;//Returns new Address
+ published
+ end;
+
+ TOniDataADB = class(TOniData)
+ private
+ FDatabase:TABSDatabase;
+ FQuery:TABSQuery;
+ protected
+ public
+ constructor Create(OLDBFilename:String; var Result:Boolean); override;
+ procedure Close; override;
+
+ function GetFileInfo(fileid:LongWord):TFileInfo; override;
+ function GetFilesList(ext:String; pattern:String; NoEmptyFiles:Boolean):TStringArray; override;
+ function GetFilesCount:LongWord; override;
+ function GetExtensionsList:TStringArray; override;
+
+ function LoadDatFile(fileid:LongWord):Tdata; override;
+ procedure UpdateDatFile(fileid:LongWord; data:Tdata); override;
+ procedure LoadDatFilePart(fileid,offset,size:LongWord; target:Pointer); override;
+ procedure UpdateDatFilePart(fileid,offset,size:LongWord; target:Pointer); override;
+
+ function GetRawList(fileid:LongWord):TRawList; override;
+ procedure LoadRawFile(fileid,dat_offset:LongWord; target:Pointer); override;
+ procedure UpdateRawFile(fileid,dat_offset:LongWord; size:LongWord; target:Pointer); override;
+ procedure LoadRawFilePart(fileid,dat_offset:LongWord; offset,size:LongWord; target:Pointer); override;
+ procedure UpdateRawFilePart(fileid,dat_offset:LongWord; offset,size:LongWord; target:Pointer); override;
+ published
+ end;
+
+
+const
+ ODB_None=-1;
+ ODB_Dat=0;
+ ODB_ADB=1;
+
+var
+ OniDataConnection:TOniData;
+
+function CreateDataConnection(filename:String; backend:Integer):Boolean;
+procedure CloseDataConnection;
+
+
+
+
+implementation
+uses Unit2_Functions;
+
+
+
+(*
+ Implementation of TOniData
+*)
+
+function TOniData.GetFileIDByName(name:String):LongWord;
+ begin
+ if AppSettings.FilenumbersAsHex then
+ Result:=HexToLong(MidStr(name,1,4))
+ else
+ Result:=StrToInt(MidStr(name,1,5));
+ end;
+
+function TOniData.GetRawInfo(fileid,dat_offset:LongWord):TRawInfo;
+ var
+ i:LongWord;
+ raw_list:TRawList;
+ begin
+ raw_list:=Self.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;
+
+
+
+
+
+
+
+(*
+================================================================================
+ Implementation of TOniDataDat
+*)
+
+constructor TOniDataDat.Create(DatFilename:String; var Result:Boolean);
+ const
+ header_ident1_pc:Array[0..$13] of Byte=
+ ($1F,$27,$DC,$33,$DF,$BC,$03,$00,$31,$33,$52,$56,$40,$00,$14,$00,$10,$00,$08,$00);
+ header_ident1_mac:Array[0..$13] of Byte=
+ ($61,$30,$C1,$23,$DF,$BC,$03,$00,$31,$33,$52,$56,$40,$00,$14,$00,$10,$00,$08,$00);
+ header_ident2:Array[0..$F] of Byte=
+ ($99,$CF,$40,$00,$90,$4F,$63,$00,$F4,$55,$5F,$00,$90,$4F,$63,$00);
+ var
+ i:LongWord;
+ dat_file:TFileStream;
+ header_pc,header_mac:Boolean;
+ begin
+ if not FileExists(DatFilename) then begin
+ ShowMessage('File doesn''t exist!!!');
+ Result:=False;
+ Exit;
+ end;
+ FFileName:=DatFilename;
+ dat_file:=TFileStream.Create(FFileName, fmOpenRead);
+ dat_file.Read(Fdat_header,SizeOf(Fdat_header));
+ header_pc:=True;
+ header_mac:=True;
+ for i:=0 to High(Fdat_header.Ident) do begin
+ FLevelInfo.Ident[i]:=Fdat_header.Ident[i];
+ if Fdat_header.Ident[i]<>header_ident1_pc[i] then begin
+ header_pc:=False;
+ end;
+ if Fdat_header.Ident[i]<>header_ident1_mac[i] then begin
+ header_mac:=False;
+ end;
+ end;
+ if not (header_pc xor header_mac) then begin
+ Result:=False;
+ Exit;
+ end else begin
+ if (header_pc and not header_mac) then
+ Fos_mac:=False
+ else
+ Fos_mac:=True;
+ end;
+ SetLength(Fdat_filesmap,Fdat_header.Files);
+ SetLength(Fdat_files,Fdat_header.Files);
+ for i:=0 to Fdat_header.Files-1 do
+ dat_file.Read(Fdat_filesmap[i],SizeOf(Fdat_filesmap[i]));
+ for i:=0 to Fdat_header.Files-1 do begin
+ Fdat_files[i].Extension:=Fdat_filesmap[i].Extension;
+ Fdat_files[i].Extension:=ReverseString(Fdat_files[i].Extension);
+ Fdat_files[i].Size:=Fdat_filesmap[i].FileSize;
+ Fdat_files[i].FileType:=Fdat_filesmap[i].FileType;
+ Fdat_files[i].DatAddr:=Fdat_filesmap[i].DataAddr-8+Fdat_header.DataAddr;
+ if (Fdat_filesmap[i].FileType and $01)=0 then begin
+ dat_file.Seek(Fdat_filesmap[i].NameAddr+Fdat_header.NamesAddr,soFromBeginning);
+ SetLength(Fdat_files[i].Name,100);
+ dat_file.Read(Fdat_files[i].Name[1],100);
+ Fdat_files[i].Name:=MidStr(Fdat_files[i].Name,1+4,Pos(#0,Fdat_files[i].Name)-1-4);
+ end else begin
+ Fdat_files[i].Name:='';
+ end;
+ Fdat_files[i].FileName:=FormatNumber(i,5,'0')+'-'+Fdat_files[i].Name+'.'+Fdat_files[i].Extension;
+ Fdat_files[i].FileNameHex:=IntToHex(i,4)+'-'+Fdat_files[i].Name+'.'+Fdat_files[i].Extension;
+ end;
+ dat_file.Seek($40+Fdat_header.Files*$14,soFromBeginning);
+ SetLength(Fdat_namedfilesmap,Fdat_header.NamedFiles);
+ for i:=0 to Fdat_header.NamedFiles-1 do
+ dat_file.Read(Fdat_namedfilesmap[i],SizeOf(Fdat_namedfilesmap[i]));
+
+ dat_file.Seek($40+Fdat_header.Files*$14+Fdat_header.NamedFiles*$8,soFromBeginning);
+ SetLength(Fdat_extensionsmap,Fdat_header.Extensions);
+ for i:=0 to Fdat_header.Extensions-1 do
+ dat_file.Read(Fdat_extensionsmap[i],SizeOf(Fdat_extensionsmap[i]));
+
+ dat_file.Seek(Fdat_files[0].DatAddr+7,soFromBeginning);
+ dat_file.Read(FLevelInfo.LevelNumber,1);
+ FLevelInfo.LevelNumber:=FLevelInfo.LevelNumber DIV 2;
+
+ dat_file.Free;
+
+ Result:=True;
+ FBackend:=ODB_Dat;
+ end;
+
+procedure TOniDataDat.Close;
+ begin
+ Self.Free;
+ end;
+
+
+
+function TOniDataDat.GetFileInfo(fileid:LongWord):TFileInfo;
+ begin
+ if fileid0) ) and
+ ( (Length(pattern)=0) or (Pos(UpperCase(pattern),UpperCase(Fdat_files[i].Name))>0) ) then begin
+ if (NoEmptyFiles=false) or ((Fdat_files[i].FileType and $02)=0) then begin
+ SetLength(Result,Length(Result)+1);
+ if AppSettings.FilenumbersAsHex then
+ Result[High(Result)]:=Fdat_files[i].FileNameHex
+ else
+ Result[High(Result)]:=Fdat_files[i].FileName;
+ end;
+ end;
+ end;
+ end;
+
+function TOniDataDat.GetFilesCount:LongWord;
+ begin
+ Result:=Fdat_header.Files;
+ end;
+
+function TOniDataDat.GetExtensionsList:TStringArray;
+ var
+ i:LongWord;
+ begin
+ SetLength(Result,0);
+ for i:=0 to Fdat_header.Extensions-1 do begin
+ SetLength(Result,Length(Result)+1);
+ with Fdat_extensionsmap[i] do begin
+ Result[High(Result)]:=Extension[3]+Extension[2]+Extension[1]+Extension[0]+' ('+IntToStr(ExtCount)+')';
+ end;
+ end;
+ end;
+
+
+
+function TOniDataDat.LoadDatFile(fileid:LongWord):Tdata;
+ var
+ dat_file:TFileStream;
+ begin
+ if fileidDBversion then begin
+ ShowMessage('Database-file '+#13+#10+
+ '"'+OLDBFilename+'"'+#13+#10+
+ 'has wrong version. (Required: '+DBversion+'; found: '+
+ FQuery.FieldByName('value').AsString+')');
+ FQuery.Close;
+ Result:=False;
+ Exit;
+ end;
+ end;
+ if FQuery.FieldByName('name').AsString='lvl' then begin
+ FLevelInfo.LevelNumber:=StrToInt(FQuery.FieldByName('value').AsString);
+ end;
+ if FQuery.FieldByName('name').AsString='ident' then begin
+ temps:=FQuery.FieldByName('value').AsString;
+ for i:=0 to High(FLevelInfo.Ident) do begin
+ j:=i*2+1;
+ case temps[j] of
+ '0'..'9': FLevelInfo.Ident[i]:=Ord(temps[j])-48;
+ 'A'..'F': FLevelInfo.Ident[i]:=Ord(temps[j])-55;
+ end;
+ FLevelInfo.Ident[i]:=FLevelInfo.Ident[i]*16;
+ case temps[j+1] of
+ '0'..'9': FLevelInfo.Ident[i]:=FLevelInfo.Ident[i]+Ord(temps[j+1])-48;
+ 'A'..'F': FLevelInfo.Ident[i]:=FLevelInfo.Ident[i]+Ord(temps[j+1])-55;
+ end;
+ end;
+ end;
+ if FQuery.FieldByName('name').AsString='ident' then begin
+ temps:=FQuery.FieldByName('value').AsString;
+ Fos_mac:=temps='MAC';
+ end;
+ FQuery.Next;
+ until FQuery.EoF;
+ FQuery.Close;
+
+ Result:=True;
+ FBackend:=ODB_ADB;
+ end;
+
+procedure TOniDataADB.Close;
+ begin
+ FDatabase.Close;
+ FDatabase.Free;
+ Self.Free;
+ end;
+
+
+
+function TOniDataADB.GetFileInfo(fileid:LongWord):TFileInfo;
+ begin
+ if fileid0 then begin
+ if Length(where)>0 then
+ where:=where+' AND ';
+ if Pos(',',ext)>0 then begin
+ i:=1;
+ where_ext:='';
+ while i0 then
+ where_ext:=where_ext+' OR ';
+ where_ext:=where_ext+'(extension="'+MidStr(ext,i,4)+'")';
+ i:=i+5;
+ end;
+ where:=where+'('+where_ext+')';
+ end else begin
+ where:=where+'(extension="'+ext+'")';
+ end;
+ end;
+ if Length(pattern)>0 then begin
+ if Length(where)>0 then
+ where:=where+' AND ';
+ where:=where+'(name LIKE "%'+pattern+'%")';
+ end;
+ if NoEmptyFiles then begin
+ if Length(where)>0 then
+ where:=where+' AND ';
+ where:=where+'(contenttype<>2)';
+ end;
+ if Length(where)>0 then
+ where:=' WHERE '+where;
+ FQuery.SQL.Text:='SELECT id,name,extension FROM datfiles'+where+' ORDER BY id ASC;';
+ FQuery.Open;
+ if FQuery.RecordCount>0 then begin
+ FQuery.First;
+ SetLength(Result,FQuery.RecordCount);
+ i:=0;
+ repeat
+ Result[i]:=FormatNumber(FQuery.FieldByName('id').AsInteger,5,'0')+'-'+FQuery.FieldByName('name').AsString+'.'+FQuery.FieldByName('extension').AsString;
+ Inc(i);
+ FQuery.Next;
+ until FQuery.EOF;
+ end;
+ FQuery.Close;
+ end;
+
+function TOniDataADB.GetFilesCount:LongWord;
+ begin
+ FQuery.SQL.Text:='SELECT Count(*) AS cnumber FROM datfiles;';
+ FQuery.Open;
+ if FQuery.RecordCount>0 then begin
+ FQuery.First;
+ Result:=FQuery.FieldByName('cnumber').AsInteger;
+ end else Result:=0;
+ FQuery.Close;
+ end;
+
+function TOniDataADB.GetExtensionsList:TStringArray;
+ var
+ i:LongWord;
+ begin
+ SetLength(Result,0);
+ FQuery.SQL.Text:='SELECT extension,count(extension) AS x FROM datfiles GROUP BY extension ORDER BY extension ASC;';
+ FQuery.Open;
+ if FQuery.RecordCount>0 then begin
+ SetLength(Result,FQuery.RecordCount);
+ i:=0;
+ repeat
+ Result[i]:=FQuery.FieldByName('extension').AsString+' ('+IntToStr(FQuery.FieldByName('x').AsInteger)+')';
+ Inc(i);
+ FQuery.Next;
+ until FQuery.EOF;
+ end;
+ FQuery.Close;
+ end;
+
+
+
+function TOniDataADB.LoadDatFile(fileid:LongWord):Tdata;
+ var
+ mem:TStream;
+ begin
+ if fileid0 then begin
+ mem:=FQuery.CreateBlobStream(FQuery.FieldByName('data'),bmRead);
+ SetLength(Result,mem.Size);
+ mem.Seek(0,soFromBeginning);
+ mem.Read(Result[0],mem.Size);
+ mem.Free;
+ end;
+ FQuery.Close;
+ end;
+ end;
+
+procedure TOniDataADB.UpdateDatFile(fileid:LongWord; data:Tdata);
+ var
+ MimeCoder: TStringFormat_MIME64;
+ mem:TMemoryStream;
+ begin
+ if fileid0 THEN BEGIN
+ mem:=FQuery.CreateBlobStream(FQuery.FieldByName('data'),bmRead);
+ mem.Seek(offset,soFromBeginning);
+ mem.Read(target^,size);
+ mem.Free;
+ END;
+ FQuery.Close;
+ END;
+ END;
+
+procedure TOniDataADB.UpdateDatFilePart(fileid,offset,size:LongWord; target:Pointer);
+ var
+ MimeCoder: TStringFormat_MIME64;
+ mem:TMemoryStream;
+ data:Tdata;
+ begin
+ if fileid0 then begin
+ FQuery.First;
+ SetLength(Result,FQuery.RecordCount);
+ i:=0;
+ repeat
+ Result[i].src_id:=fileid;
+ Result[i].src_offset:=FQuery.FieldByName('src_link_offset').AsInteger;
+ Result[i].raw_addr:=0;
+ Result[i].raw_size:=FQuery.FieldByName('size').AsInteger;
+ Inc(i);
+ FQuery.Next;
+ until FQuery.EOF;
+ end;
+ FQuery.Close;
+ end;
+
+procedure TOniDataADB.LoadRawFile(fileid,dat_offset:LongWord; target:Pointer);
+ var
+ mem:TStream;
+ begin
+ if fileid0 then begin
+ mem:=FQuery.CreateBlobStream(FQuery.FieldByName('data'),bmRead);
+ mem.Seek(0,soFromBeginning);
+ mem.Read(target^,mem.size);
+ mem.Free;
+ end;
+ FQuery.Close;
+ end;
+ end;
+
+procedure TOniDataADB.UpdateRawFile(fileid,dat_offset:LongWord; size:LongWord; target:Pointer);
+ var
+ MimeCoder: TStringFormat_MIME64;
+ mem:TMemoryStream;
+ begin
+ if fileid
+ ParentBiDiMode = False
+ ExplicitTop = 527
+ ExplicitWidth = 692
+ end
+ object tabs: TTabSet
+ Left = 0
+ Top = 439
+ Width = 577
+ Height = 20
+ Align = alBottom
+ DitherBackground = False
+ Font.Charset = DEFAULT_CHARSET
+ Font.Color = clWindowText
+ Font.Height = -11
+ Font.Name = 'Tahoma'
+ Font.Style = []
+ SoftTop = True
+ Style = tsModernTabs
+ OnChange = tabsChange
+ ExplicitTop = 507
+ ExplicitWidth = 692
+ end
+ object opend: TOpenDialog
+ Options = [ofPathMustExist, ofFileMustExist, ofEnableSizing]
+ Left = 328
+ end
+ object menu: TMainMenu
+ AutoHotkeys = maManual
+ Left = 424
+ object menu_main: TMenuItem
+ Caption = '&Main'
+ object menu_loaddat: TMenuItem
+ Caption = '&Select .dat-file ...'
+ ShortCut = 16463
+ OnClick = menu_loaddatClick
+ end
+ object menu_lvldb: TMenuItem
+ Caption = 'Open OUP-Level-&DB ...'
+ ShortCut = 16452
+ OnClick = menu_lvldbClick
+ end
+ object menu_CloseFileDB: TMenuItem
+ Caption = '&Close file/DB'
+ OnClick = menu_CloseFileDBClick
+ end
+ object menu_sep1: TMenuItem
+ Caption = '-'
+ end
+ object menu_settings: TMenuItem
+ Caption = 'Se&ttings...'
+ OnClick = menu_settingsClick
+ end
+ object menu_sep4: TMenuItem
+ Caption = '-'
+ end
+ object menu_exit: TMenuItem
+ Caption = '&Exit'
+ OnClick = menu_exitClick
+ end
+ end
+ object menu_convert: TMenuItem
+ Caption = '&Convert'
+ object menu_createdb: TMenuItem
+ Caption = 'Create level-database ...'
+ OnClick = menu_createdbClick
+ end
+ object menu_createlvl: TMenuItem
+ Caption = 'Create level-files ...'
+ OnClick = menu_createlvlClick
+ end
+ end
+ object menu_tools: TMenuItem
+ Caption = '&Tools'
+ Enabled = False
+ object menu_preview: TMenuItem
+ Caption = '&Preview Window ...'
+ ShortCut = 16464
+ OnClick = menu_previewClick
+ end
+ object menu_binedit: TMenuItem
+ Caption = '&Binary .dat editor ...'
+ ShortCut = 16450
+ OnClick = menu_bineditClick
+ end
+ object menu_rawedit: TMenuItem
+ Caption = 'Binary .&raw editor ...'
+ ShortCut = 16466
+ OnClick = menu_raweditClick
+ end
+ object menu_txmpreplace: TMenuItem
+ Caption = '&TXMP replacer ...'
+ ShortCut = 16468
+ OnClick = menu_txmpreplaceClick
+ end
+ object menu_extractor: TMenuItem
+ Caption = 'File &extractor ...'
+ ShortCut = 16453
+ OnClick = menu_extractorClick
+ end
+ object menu_filecompare: TMenuItem
+ Caption = '&File compare ...'
+ Enabled = False
+ ShortCut = 16454
+ OnClick = menu_filecompareClick
+ end
+ object menu_levelstructedit: TMenuItem
+ Caption = 'Levelfile structure editor ...'
+ Enabled = False
+ ShortCut = 16460
+ end
+ end
+ object menu_windows: TMenuItem
+ Caption = '&Windows'
+ object menu_windows_cascade: TMenuItem
+ Caption = 'Cascade'
+ OnClick = menu_windows_cascadeClick
+ end
+ object menu_windows_tile: TMenuItem
+ Caption = 'Tile'
+ OnClick = menu_windows_tileClick
+ end
+ object menu_windows_closeall: TMenuItem
+ Caption = '&Close all'
+ OnClick = menu_windows_closeallClick
+ end
+ object menu_sep3: TMenuItem
+ Caption = '-'
+ end
+ object menu_windows_next: TMenuItem
+ Caption = 'Next window'
+ ShortCut = 16417
+ OnClick = menu_windows_nextClick
+ end
+ object menu_windows_previous: TMenuItem
+ Caption = 'Previous window'
+ ShortCut = 16418
+ OnClick = menu_windows_previousClick
+ end
+ object menu_sep2: TMenuItem
+ Caption = '-'
+ end
+ end
+ object menu_About: TMenuItem
+ Caption = '&About'
+ OnClick = menu_AboutClick
+ end
+ end
+ object saved: TSaveDialog
+ Options = [ofOverwritePrompt, ofPathMustExist, ofEnableSizing]
+ Left = 376
+ end
+end
Index: oup/releases/0.30a/Unit1_main.pas
===================================================================
--- oup/releases/0.30a/Unit1_main.pas (revision 33)
+++ oup/releases/0.30a/Unit1_main.pas (revision 33)
@@ -0,0 +1,527 @@
+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,
+ Unit15_Classes;
+
+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;
+ menu_CloseFileDB: TMenuItem;
+ menu_sep4: TMenuItem;
+ menu_settings: TMenuItem;
+ menu_About: TMenuItem;
+ FUNCTION TryCloseAll:Boolean;
+ procedure menu_AboutClick(Sender: TObject);
+ PROCEDURE menu_settingsClick(Sender: TObject);
+ PROCEDURE menu_CloseFileDBClick(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);
+ PROCEDURE UpdateStatBar;
+ 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
+ IF NOT CreateDataConnection(ParamStr(2), ODB_ADB) THEN
+ ShowMessage('Error while loading the file:'+CrLf+ParamStr(2)+CrLf+'Perhaps not an OniUnPacker-LevelDatabase-file?');
+ END ELSE IF MidStr(ParamStr(1),1,3)='dat' THEN BEGIN
+ IF NOT CreateDataConnection(ParamStr(2), ODB_Dat) THEN
+ ShowMessage('Error while loading the file:'+CrLf+ParamStr(2)+CrLf+'Perhaps not an Oni-.dat-file?');
+ END;
+ UpdateStatBar;
+ 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: oup/releases/0.30a/Unit2_functions.pas
===================================================================
--- oup/releases/0.30a/Unit2_functions.pas (revision 33)
+++ oup/releases/0.30a/Unit2_functions.pas (revision 33)
@@ -0,0 +1,247 @@
+UNIT Unit2_functions;
+INTERFACE
+USES Classes, Dialogs, SysUtils, StrUtils, Math,
+ Unit3_data;
+
+TYPE
+ TExportSet=SET OF (DO_dat,DO_raw,DO_convert,DO_toone);
+
+FUNCTION HexToLong(hex:String):LongWord;
+FUNCTION Decode_Int(buffer:Tdata):LongWord;
+FUNCTION Encode_Int(input:LongWord):Tdata;
+FUNCTION Decode_Float(buffer:Tdata):Single;
+FUNCTION Encode_Float(input:Single):Tdata;
+FUNCTION DataToBin(data:Tdata):String;
+FUNCTION BinToInt(bin:String):Byte;
+
+FUNCTION ExportFile(fileid:LongWord; filename:String; settings:TExportSet; path:String):Integer;
+
+FUNCTION FormatNumber(value:LongWord; width:Byte; leadingzeros:Char):String;
+FUNCTION FormatFileSize(size:LongWord):String;
+FUNCTION CreateHexString(data:Tdata; HexOnly:Boolean):String;
+FUNCTION GetWinFileName(name:String):String;
+FUNCTION GetExtractPath:String;
+
+FUNCTION Explode(_string:String; delimiter:Char):TStringArray;
+
+
+IMPLEMENTATION
+USES Unit4_Exporters, Unit15_Classes;
+
+TYPE
+ TValueSwitcher=Record
+ CASE IsFloat: Boolean OF
+ True: (ValueFloat:Single);
+ False: (ValueInt:LongWord);
+ END;
+
+
+FUNCTION HexToLong(hex:String):LongWord;
+ FUNCTION NormalizeHexString(VAR hex:String):Boolean;
+ VAR
+ i:Byte;
+ BEGIN
+ IF hex[1]='$' THEN BEGIN
+ FOR i:=1 TO Length(hex)-1 DO BEGIN
+ hex[i]:=hex[i+1];
+ END;
+ SetLength(hex, Length(hex)-1);
+ END;
+ IF (hex[1]='0') AND (UpCase(hex[2])='X') THEN BEGIN
+ FOR i:=1 TO Length(hex)-2 DO BEGIN
+ hex[i]:=hex[i+2];
+ END;
+ SetLength(hex, Length(hex)-2);
+ END;
+ IF Length(hex)=0 THEN
+ Result:=False
+ ELSE
+ Result:=True;
+ END;
+ VAR
+ i:Byte;
+ BEGIN
+ IF NormalizeHexString(hex) THEN BEGIN
+ hex:=UpperCase(hex);
+ Result:=0;
+ FOR i:=1 TO Length(hex) DO BEGIN
+ Result:=Result SHL 4;
+ CASE hex[i] OF
+ '0'..'9': Result:=Result+Ord(hex[i])-48;
+ 'A'..'F': Result:=Result+Ord(hex[i])-55;
+ ELSE
+ Result:=0;
+ Exit;
+ END;
+ END;
+ END ELSE BEGIN
+ Result:=0;
+ END;
+ END;
+
+FUNCTION Decode_Int(buffer:Tdata):LongWord;
+ BEGIN
+ Result:=buffer[0]+buffer[1]*256+buffer[2]*256*256+buffer[3]*256*256*256;
+ END;
+FUNCTION Encode_Int(input:LongWord):Tdata;
+ BEGIN
+ SetLength(Result,4);
+ Result[0]:=input MOD 256;
+ input:=input DIV 256;
+ Result[1]:=input MOD 256;
+ input:=input DIV 256;
+ Result[2]:=input MOD 256;
+ input:=input DIV 256;
+ Result[3]:=input MOD 256;
+ END;
+FUNCTION Decode_Float(buffer:Tdata):Single;
+ VAR _valueswitcher:TValueSwitcher;
+ BEGIN
+ _valueswitcher.ValueInt:=Decode_Int(buffer);
+ Result:=_valueswitcher.ValueFloat;
+ IF IsNAN(Result) THEN Result:=0.0;
+ END;
+FUNCTION Encode_Float(input:Single):Tdata;
+ VAR _valueswitcher:TValueSwitcher;
+ BEGIN
+ _valueswitcher.ValueFloat:=input;
+ Result:=Encode_Int(_valueswitcher.ValueInt);
+ END;
+
+FUNCTION DataToBin(data:Tdata):String;
+ VAR
+ i,j:Byte;
+ singlebyte:Byte;
+ bytepart:String;
+ BEGIN
+ SetLength(bytepart,8);
+ Result:='';
+ FOR i:=0 TO High(data) DO BEGIN
+ singlebyte:=data[i];
+ FOR j:=7 DOWNTO 0 DO BEGIN
+ bytepart[j+1]:=Char((singlebyte AND $01)+48);
+ singlebyte:=singlebyte SHR 1;
+ END;
+ Result:=Result+bytepart+' ';
+ END;
+ END;
+FUNCTION BinToInt(bin:String):Byte;
+ VAR
+ Add: Integer;
+ i: Byte;
+ BEGIN
+ Result:=0;
+ IF Length(bin)<>8 THEN Exit;
+ Add:=1;
+ FOR i:=8 DOWNTO 1 DO BEGIN
+ IF NOT (bin[i] IN ['0','1']) THEN Exit;
+ IF bin[i] = '1' THEN Inc(Result,Add);
+ Add:=Add SHL 1;
+ END;
+ END;
+
+
+
+FUNCTION FormatNumber(value:LongWord; width:Byte; leadingzeros:Char):String;
+ BEGIN
+ Result:=AnsiReplaceStr(Format('%'+IntToStr(width)+'u',[value]),' ',leadingzeros);
+ END;
+
+FUNCTION FormatFileSize(size:LongWord):String;
+ BEGIN
+ IF size>=1000*1024*1024 THEN BEGIN
+ Result:=FloatToStrF(size/1024/1024/1024,ffFixed,5,1)+' GB';
+ END ELSE BEGIN
+ IF size>=1000*1024 THEN BEGIN
+ Result:=FloatToStrF(size/1024/1024,ffFixed,5,1)+' MB';
+ END ELSE BEGIN
+ IF size>=1000 THEN BEGIN
+ Result:=FloatToStrF(size/1024,ffFixed,5,1)+' KB';
+ END ELSE BEGIN
+ Result:=IntToStr(size)+' B';
+ END;
+ END;
+ END;
+ END;
+
+FUNCTION CreateHexString(data:Tdata; HexOnly:Boolean):String;
+ VAR
+ string_build,ascii_version:String;
+ i:LongWord;
+ BEGIN
+ string_build:='';
+ ascii_version:='';
+ FOR i:=0 TO High(data) DO BEGIN
+ IF NOT HexOnly THEN
+ IF (i MOD 16)=0 THEN
+ string_build:=string_build+'0x'+IntToHex(i,6)+' ';
+ string_build:=string_build+IntToHex(data[i],2);
+ IF NOT HexOnly THEN BEGIN
+ IF data[i]>=32 THEN ascii_version:=ascii_version+Chr(data[i])
+ ELSE ascii_version:=ascii_version+'.';
+ IF ((i+1) MOD 2)=0 THEN string_build:=string_build+#32;
+ IF ((i+1) MOD 16)=0 THEN BEGIN
+ string_build:=string_build+#32+ascii_version+CrLf;
+ ascii_version:='';
+ END;
+ END;
+ END;
+ Result:=string_build;
+ END;
+
+
+FUNCTION ExportFile(fileid:LongWord; filename:String; settings:TExportSet; path:String):Integer;
+ VAR
+ i:Byte;
+ extension:String;
+ rawlist:TRawList;
+ BEGIN
+ Result:=export_noerror;
+ extension:=RightStr(filename,4);
+ IF DO_toone IN settings THEN BEGIN
+ ExportDatFile(fileid,path+'\'+GetWinFileName(filename));
+ END ELSE BEGIN
+ IF DO_dat IN settings THEN ExportDatFile(fileid,path+'\'+GetWinFileName(filename));
+ IF DO_raw IN settings THEN BEGIN
+ rawlist:=OniDataConnection.GetRawList(fileid);
+ IF Length(rawlist)>0 THEN BEGIN
+ FOR i:=0 TO High(rawlist) DO BEGIN
+ ExportRawFile(fileid,rawlist[i].src_offset,path+'\'+GetWinFileName(filename));
+ END;
+ END;
+ END;
+ END;
+ END;
+
+FUNCTION Explode(_string:String; delimiter:Char):TStringArray;
+ VAR
+ start,len:Word;
+ BEGIN
+ SetLength(Result, 0);
+ start:=1;
+ WHILE PosEx(delimiter,_string,start)>0 DO BEGIN
+ len:=PosEx(delimiter,_string,start)-start;
+ SetLength(Result, Length(Result)+1);
+ Result[High(Result)]:=MidStr(_string,start,len);
+ start:=start+len+1;
+ END;
+ SetLength(Result, Length(Result)+1);
+ Result[High(Result)]:=MidStr(_string,start,Length(_string)-start+1);
+ END;
+
+FUNCTION GetWinFileName(name:String):String;
+ BEGIN
+ Result:=name;
+ Result:=AnsiReplaceStr(Result,'\','__');
+ Result:=AnsiReplaceStr(Result,'/','__');
+ Result:=AnsiReplaceStr(Result,'>','__');
+ Result:=AnsiReplaceStr(Result,'<','__');
+ END;
+
+FUNCTION GetExtractPath:String;
+ BEGIN
+ Result:=ExtractFilePath(dat_filename)+'\extracted_'+ExtractFileName(dat_filename);
+ END;
+
+
+END.
Index: oup/releases/0.30a/Unit3_data.pas
===================================================================
--- oup/releases/0.30a/Unit3_data.pas (revision 33)
+++ oup/releases/0.30a/Unit3_data.pas (revision 33)
@@ -0,0 +1,122 @@
+unit Unit3_data;
+interface
+uses Classes;
+
+const
+ Version:String='v0.29a';
+ DBVersion:String='0.2';
+ CrLf:String[2]=#13+#10;
+
+type
+ TData=Array of Byte;
+ THeader=packed Record
+ Ident:Array[0..$13] of Byte;
+ Files:LongWord;
+ NamedFiles:LongWord;
+ Extensions:LongWord;
+ DataAddr:LongWord;
+ DataSize:LongWord;
+ NamesAddr:LongWord;
+ NamesSize:LongWord;
+ Ident2:Array[0..$F] of Byte;
+ end;
+ TFilesMap=Array of packed Record
+ Extension:Array[0..$3] of Char;
+ DataAddr:LongWord;
+ NameAddr:LongWord;
+ FileSize:LongWord;
+ FileType:LongWord;
+ end;
+ TFileInfo=packed Record
+ ID:Integer;
+ FileName:String;
+ FileNameHex:String;
+ Extension:String[4];
+ Name:String;
+ Size:LongWord;
+ FileType:LongWord;
+ DatAddr:LongWord;
+ opened:Boolean;
+ end;
+ TFiles=Array of TFileInfo;
+
+ TNamedFilesMap=Array of packed Record
+ FileNumber:LongWord;
+ blubb:LongWord;
+ end;
+ TExtensionsMap=Array of packed Record
+ Ident:Array[0..$7] of Byte;
+ Extension:Array[0..$3] of Char;
+ ExtCount:LongWord;
+ end;
+
+ TLevelInfo=Record
+ Ident:Array[0..$13] of Byte;
+ LevelNumber:Byte;
+ end;
+
+ TAppSettings=Record
+ DatPath:String[250];
+ ExtractPath:String[250];
+ FilenumbersAsHex:Boolean;
+ end;
+
+ TExportHandlers=Record
+ Ext:String[4];
+ needed:Boolean;
+ Handler:Function(fileid:LongWord; filename:String; convert:Boolean):Integer;
+ end;
+
+ TStringArray=Array of String;
+ TExtList=Array of Record
+ Ext:String;
+ count:LongWord;
+ end;
+
+ TRawInfo=Record
+ src_id:LongWord;
+ src_offset:LongWord;
+ raw_addr:LongWord;
+ raw_size:LongWord;
+ loc_sep:Boolean;
+ end;
+ TRawList=Array of TRawInfo;
+
+var
+
+ opened_state:Byte=0;
+ dat_filename:String='';
+ raw_filename:String='';
+ dat_os_mac:Boolean=False;
+ dat_header:Theader;
+ dat_filesmap:Tfilesmap;
+ dat_files:Tfiles;
+ dat_namedfilesmap:Tnamedfilesmap;
+ dat_extensionsmap:Textensionsmap;
+ AppSettings:TAppSettings;
+ AppSettingsFile:File of TAppSettings;
+
+ database_level:LongWord;
+ database_ident:Array[0..$13] of Byte;
+
+const
+ header_ident1_pc:Array[0..$13] of Byte=
+ ($1F,$27,$DC,$33,$DF,$BC,$03,$00,$31,$33,$52,$56,$40,$00,$14,$00,$10,$00,$08,$00);
+ header_ident1_mac:Array[0..$13] of Byte=
+ ($61,$30,$C1,$23,$DF,$BC,$03,$00,$31,$33,$52,$56,$40,$00,$14,$00,$10,$00,$08,$00);
+ header_ident2:Array[0..$F] of Byte=
+ ($99,$CF,$40,$00,$90,$4F,$63,$00,$F4,$55,$5F,$00,$90,$4F,$63,$00);
+
+ export_noerror:Integer=0;
+ export_nohandler:Integer=1;
+ export_handlererror:Integer=2;
+ export_error:Integer=3;
+
+ opened_nothing:Byte=0;
+ opened_dat:Byte=1;
+ opened_db:Byte=2;
+
+implementation
+
+end.
+
Index: oup/releases/0.30a/Unit4_Exporters.pas
===================================================================
--- oup/releases/0.30a/Unit4_Exporters.pas (revision 33)
+++ oup/releases/0.30a/Unit4_Exporters.pas (revision 33)
@@ -0,0 +1,218 @@
+UNIT Unit4_Exporters;
+INTERFACE
+USES Classes, Dialogs, StrUtils, SysUtils, Math, Unit3_data, Unit6_imgfuncs;
+
+PROCEDURE ExportDatFile(fileid:LongWord; filename:String);
+PROCEDURE ExportRawFile(fileid:LongWord; dat_offset:LongWord; filename:String);
+
+FUNCTION ExportSNDD(fileid:LongWord; filename:String; convert:Boolean):Integer;
+FUNCTION ExportTRAC(fileid:LongWord; filename:String; convert:Boolean):Integer;
+FUNCTION ExportTXAN(fileid:LongWord; filename:String; convert:Boolean):Integer;
+FUNCTION ExportTXMB(fileid:LongWord; filename:String; convert:Boolean):Integer;
+FUNCTION ExportTXMP(fileid:LongWord; filename:String; convert:Boolean):Integer;
+VAR
+ ExportHandlers:Array[1..1] OF TExportHandlers=(
+// (Ext:'ABNA'; needed:False),
+ //(Ext:'AGDB'; needed:False),
+ (Ext:'SNDD'; needed:True; Handler:ExportSNDD)
+{ (Ext:'TRAC'; needed:True; Handler:ExportTRAC),
+ (Ext:'TXAN'; needed:True; Handler:ExportTXAN),
+ (Ext:'TXMB'; needed:True; Handler:ExportTXMB),
+ (Ext:'TXMP'; needed:True; Handler:ExportTXMP)
+} );
+
+
+
+IMPLEMENTATION
+USES Unit2_functions, Unit9_data_structures, Unit15_Classes;
+
+PROCEDURE ExportDatFile(fileid:LongWord; filename:String);
+ VAR
+ filestream:TFileStream;
+ data:Tdata;
+ BEGIN
+ data:=OniDataConnection.LoadDatFile(fileid);
+ IF FileExists(filename) THEN BEGIN
+ filestream:=TFileStream.Create(filename,fmOpenReadWrite);
+ filestream.Seek(0,soFromEnd);
+ END ELSE BEGIN
+ filestream:=TFileStream.Create(filename,fmCreate);
+ END;
+ filestream.Write(data[0],Length(data));
+ filestream.Free;
+ END;
+
+PROCEDURE ExportRawFile(fileid:LongWord; dat_offset:LongWord; filename:String);
+ VAR
+ filestream:TFileStream;
+ data:Tdata;
+ BEGIN
+ SetLength(data, OniDataConnection.GetRawInfo(fileid, dat_offset).raw_size);
+ OniDataConnection.LoadRawFile(fileid,dat_offset,@data[0]);
+ IF FileExists(filename+'.raw0x'+IntToHex(dat_offset,8)) THEN BEGIN
+ filestream:=TFileStream.Create(filename+'.raw0x'+IntToHex(dat_offset,8),fmOpenReadWrite);
+ filestream.Seek(0,soFromEnd);
+ END ELSE BEGIN
+ filestream:=TFileStream.Create(filename+'.raw0x'+IntToHex(dat_offset,8),fmCreate);
+ END;
+ filestream.Write(data[0],Length(data));
+ filestream.Free;
+ END;
+
+FUNCTION ExportSNDD;
+{ CONST
+ WAVheader:Array[0..0] OF Byte=(
+ Ord('R'),Ord('I'),Ord('F'),Ord('F'),0,0,0,0,Ord('W'),Ord('A'),Ord('V'),Ord('E'),
+ Ord('f'),Ord('m'),Ord('t'),Ord(' '),24,0,0,0,
+ );
+} TYPE
+ TDatData=RECORD
+ {0x00}
+ _fileid:LongWord;
+ level:LongWord;
+ Flag:LongWord;
+ FormatTag:Word;
+ ChanNo:Word;
+ {0x10}
+ SampleRate:LongWord;
+ BytesPSec:LongWord;
+ BPSample:LongWord;
+ BitsPS:LongWord;
+ {0x20}
+ Unknown:Array[1..7] OF LongWord;
+ Unknown2:Word;
+ {0x40}
+ RawSize:LongWord;
+ RawPos:LongWord;
+ END;
+ VAR
+ filestream:TFileStream;
+
+ DatData:TDatData;
+ //Wave Header Stuff
+ ASCII_Group:LongWord; //"RIFF"
+ WAV_Len:LongWord;
+ ASCII_WAV:LongWord; //"WAVE"
+ ASCII_FMT:LongWord; //"fmt "
+ WAV_FMT_Len:LongWord;
+ ASCII_DATA:LongWord; //"data"
+ WAV_FolLen:LongWord;
+
+ data:Tdata;
+ BEGIN
+ Result:=export_noerror;
+ OniDataConnection.LoadDatFilePart(fileid,0,SizeOf(DatData),@DatData);
+ WITH DatData DO BEGIN
+ //Initializing Header vars
+ ASCII_Group:=1179011410; // 'RIFF'
+ WAV_Len:=RAWSize+70;
+ ASCII_WAV:=1163280727; // 'WAVE'
+ ASCII_FMT:=544501094; // 'fmt '
+ WAV_FMT_Len:=50; // 50 bytes
+ ASCII_DATA:=1635017060; // 'data'
+ WAV_FolLen:=RAWSize;
+ SetLength(data,RAWSize);
+ OniDataConnection.LoadRawFile(fileid,$44,data);
+
+ filestream:=TFileStream.Create(filename+'.raw',fmCreate);
+ filestream.Write(data[0],Length(data));
+ filestream.Free;
+
+ IF convert THEN BEGIN
+ //Now start packing this into a neat wave...
+ filestream:=TFileStream.Create(filename+'.wav',fmCreate);
+ filestream.Write(ASCII_Group,SizeOf(ASCII_Group));
+ filestream.Write(WAV_Len,SizeOf(WAV_Len));
+ filestream.Write(ASCII_WAV,SizeOf(ASCII_WAV));
+ filestream.Write(ASCII_FMT,SizeOf(ASCII_FMT));
+ filestream.Write(WAV_FMT_Len,SizeOf(WAV_FMT_Len));
+ filestream.Write(ChanNo,SizeOf(ChanNo));
+ filestream.Write(Samplerate,SizeOf(Samplerate));
+ filestream.Write(BytesPSec,SizeOf(BytesPSec));
+ filestream.Write(BPSample,SizeOf(BPSample));
+ filestream.Write(BitsPS,SizeOf(BitsPS));
+ filestream.Write(Unknown[1],SizeOf(Unknown));
+ filestream.Write(Unknown2,SizeOf(Unknown2));
+ filestream.Write(ASCII_DATA,SizeOf(ASCII_DATA));
+ filestream.Write(WAV_FolLen,SizeOf(WAV_FolLen));
+ filestream.Write(data[0],Length(data));
+ filestream.Free;
+ END;
+ END;
+ END;
+
+FUNCTION ExportTRAC;
+ VAR
+ link:LongWord;
+ linkcount:Word;
+ i:LongWord;
+ BEGIN
+ Result:=export_noerror;
+
+ OniDataConnection.LoadDatFilePart(fileid,$18,SizeOf(link),@link);
+ link:=link DIV 256;
+
+ OniDataConnection.LoadDatFilePart(fileid,$1E,SizeOf(linkcount),@linkcount);
+ FOR i:=1 TO linkcount DO BEGIN
+ OniDataConnection.LoadDatFilePart(fileid,$20+(i-1)*12+8,SizeOf(link),@link);
+ link:=link DIV 256;
+ END;
+ END;
+
+FUNCTION ExportTXAN;
+ VAR
+ loop_speed,unknown:Word;
+ linkcount:LongWord;
+ link:LongWord;
+ i:Byte;
+ BEGIN
+ Result:=export_noerror;
+
+ OniDataConnection.LoadDatFilePart(fileid,$14,SizeOf(loop_speed),@loop_speed);
+ OniDataConnection.LoadDatFilePart(fileid,$16,SizeOf(unknown),@unknown);
+
+ OniDataConnection.LoadDatFilePart(fileid,$1C,SizeOf(linkcount),@linkcount);
+ FOR i:=0 TO linkcount-1 DO BEGIN
+ OniDataConnection.LoadDatFilePart(fileid,$20+i*4,SizeOf(link),@link);
+ link:=link DIV 256;
+ IF link=0 THEN link:=fileid-1;
+ END;
+ END;
+
+FUNCTION ExportTXMB;
+ VAR
+ filestream:TFileStream;
+ img:TImgPackage;
+ data:Tdata;
+ BEGIN
+ Result:=export_noerror;
+ IF convert THEN BEGIN
+ img:=LoadTXMBconnected(fileid);
+ data:=ImgdataToBmp(img.imgx,img.imgy,img.imgdepth,img.storetype,img.imgdata);
+ filestream:=TFileStream.Create(filename+'.bmp',fmCreate);
+ filestream.Write(data[0],Length(data));
+ filestream.Free;
+ END;
+ END;
+
+FUNCTION ExportTXMP;
+ VAR
+ filestream:TFileStream;
+ img:TImgPackage;
+ BEGIN
+ Result:=export_noerror;
+ img:=LoadImgData(fileid);
+
+ filestream:=TFileStream.Create(filename+'.raw',fmCreate);
+ filestream.Write(img.imgdata[0],Length(img.imgdata));
+ filestream.Free;
+
+ IF convert THEN BEGIN
+ img.imgdata:=ImgdataToBMP(img.imgx,img.imgy,img.imgdepth,img.storetype,img.imgdata);
+ filestream:=TFileStream.Create(filename+'.bmp',fmCreate);
+ filestream.Write(img.imgdata[0],Length(img.imgdata));
+ filestream.Free;
+ END;
+ END;
+
+END.
Index: oup/releases/0.30a/Unit5_preview.dfm
===================================================================
--- oup/releases/0.30a/Unit5_preview.dfm (revision 33)
+++ oup/releases/0.30a/Unit5_preview.dfm (revision 33)
@@ -0,0 +1,192 @@
+object Form5: TForm5
+ Left = 0
+ Top = 0
+ Caption = 'Preview'
+ ClientHeight = 473
+ ClientWidth = 472
+ Color = clBtnFace
+ Font.Charset = DEFAULT_CHARSET
+ Font.Color = clWindowText
+ Font.Height = -11
+ Font.Name = 'Tahoma'
+ Font.Style = []
+ FormStyle = fsMDIChild
+ OldCreateOrder = False
+ Visible = True
+ WindowState = wsMaximized
+ OnActivate = FormActivate
+ OnClose = FormClose
+ OnCreate = FormCreate
+ OnResize = FormResize
+ PixelsPerInch = 96
+ TextHeight = 13
+ object Splitter1: TSplitter
+ Left = 150
+ Top = 0
+ Width = 9
+ Height = 473
+ AutoSnap = False
+ Beveled = True
+ MinSize = 150
+ end
+ object panel_preview: TPanel
+ Left = 159
+ Top = 0
+ Width = 313
+ Height = 473
+ Align = alClient
+ BevelOuter = bvNone
+ TabOrder = 0
+ object img: TImage
+ Left = 0
+ Top = 20
+ Width = 313
+ Height = 453
+ Align = alClient
+ end
+ object lbl_notpossible: TLabel
+ Left = 16
+ Top = 56
+ Width = 97
+ Height = 65
+ AutoSize = False
+ Caption = 'No preview possible for this filetype'
+ Font.Charset = DEFAULT_CHARSET
+ Font.Color = clWindowText
+ Font.Height = -16
+ Font.Name = 'Tahoma'
+ Font.Style = []
+ ParentFont = False
+ Visible = False
+ WordWrap = True
+ end
+ object panel_buttons: TPanel
+ Left = 0
+ Top = 0
+ Width = 313
+ Height = 20
+ Align = alTop
+ BevelOuter = bvNone
+ TabOrder = 0
+ Visible = False
+ OnResize = panel_buttonsResize
+ object btn_dec: TButton
+ Left = 0
+ Top = 0
+ Width = 20
+ Height = 20
+ Caption = '-'
+ Enabled = False
+ TabOrder = 0
+ OnClick = btn_decClick
+ end
+ object btn_startstop: TButton
+ Left = 21
+ Top = 0
+ Width = 80
+ Height = 20
+ Caption = 'Stop automatic'
+ TabOrder = 1
+ OnClick = btn_startstopClick
+ end
+ object btn_inc: TButton
+ Left = 102
+ Top = 0
+ Width = 20
+ Height = 20
+ Caption = '+'
+ Enabled = False
+ TabOrder = 2
+ OnClick = btn_incClick
+ end
+ end
+ end
+ object panel_files: TPanel
+ Left = 0
+ Top = 0
+ Width = 150
+ Height = 473
+ Align = alLeft
+ BevelOuter = bvNone
+ TabOrder = 1
+ object list: TListBox
+ Left = 0
+ Top = 0
+ Width = 150
+ Height = 370
+ Align = alClient
+ ItemHeight = 13
+ TabOrder = 0
+ OnClick = listClick
+ end
+ object panel_extension: TPanel
+ Left = 0
+ Top = 370
+ Width = 150
+ Height = 103
+ Align = alBottom
+ BevelOuter = bvNone
+ TabOrder = 1
+ 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
+ end
+ object timer: TTimer
+ Enabled = False
+ OnTimer = timerTimer
+ Left = 144
+ Top = 24
+ end
+end
Index: oup/releases/0.30a/Unit5_preview.pas
===================================================================
--- oup/releases/0.30a/Unit5_preview.pas (revision 33)
+++ oup/releases/0.30a/Unit5_preview.pas (revision 33)
@@ -0,0 +1,283 @@
+UNIT Unit5_preview;
+INTERFACE
+USES
+ Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
+ Dialogs, Math, ExtCtrls, StdCtrls, StrUtils, Menus,
+ Unit2_functions, Unit3_data, Unit4_exporters, Unit6_imgfuncs, Unit15_Classes;
+
+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:TStringArray;
+ BEGIN
+ combo_extension.Items.Clear;
+ combo_extension.Items.Add('_All files_ ('+IntToStr(OniDataConnection.GetFilesCount)+')');
+ exts:=OniDataConnection.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:TStringArray;
+ 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:=OniDataConnection.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:=OniDataConnection.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
+ OniDataConnection.LoadDatFilePart(_fileid,$14,SizeOf(loop_speed),@loop_speed);
+ OniDataConnection.LoadDatFilePart(_fileid,$1C,SizeOf(linkcount),@linkcount);
+ SetLength(memstreams,linkcount);
+ FOR i:=0 TO linkcount-1 DO BEGIN
+ OniDataConnection.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 '+OniDataConnection.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 '+OniDataConnection.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*(imgdepth DIV 8))+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
+ OniDataConnection.LoadDatFilePart(fileid,$10,SizeOf(Result.imgx),@Result.imgx);
+ OniDataConnection.LoadDatFilePart(fileid,$12,SizeOf(Result.imgy),@Result.imgy);
+ OniDataConnection.LoadDatFilePart(fileid,$18,SizeOf(cols),@cols);
+ OniDataConnection.LoadDatFilePart(fileid,$1A,SizeOf(rows),@rows);
+ OniDataConnection.LoadDatFilePart(fileid,$1C,SizeOf(linkcount),@linkcount);
+ SetLength(images_decoded,linkcount);
+ FOR i:=0 TO linkcount-1 DO BEGIN
+ OniDataConnection.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 i1) AND (y>1) THEN Exit;
+ Result:=True;
+ SetLength(faded, Length(imgdata));
+ FOR i:=0 TO Length(imgdata)-1 DO faded[i]:=imgdata[i];
+ END;
+
+END.
Index: oup/releases/0.30a/Unit7_txmpreplace.dfm
===================================================================
--- oup/releases/0.30a/Unit7_txmpreplace.dfm (revision 33)
+++ oup/releases/0.30a/Unit7_txmpreplace.dfm (revision 33)
@@ -0,0 +1,190 @@
+object Form7: TForm7
+ Left = 0
+ Top = 0
+ BorderStyle = bsSingle
+ Caption = 'TXMP Replacer'
+ ClientHeight = 428
+ ClientWidth = 394
+ 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
+ OnResize = FormResize
+ PixelsPerInch = 96
+ TextHeight = 13
+ object panel_12: TPanel
+ Left = 0
+ Top = 0
+ Width = 394
+ Height = 349
+ Align = alClient
+ BevelOuter = bvNone
+ TabOrder = 0
+ object Splitter1: TSplitter
+ Left = 200
+ Top = 0
+ Width = 8
+ Height = 349
+ AutoSnap = False
+ Beveled = True
+ MinSize = 150
+ end
+ object group_txmpselect: TGroupBox
+ Left = 0
+ Top = 0
+ Width = 200
+ Height = 349
+ Align = alLeft
+ Caption = '1. Select TXMP to replace'
+ TabOrder = 0
+ object splitter_txmp: TSplitter
+ Left = 2
+ Top = 190
+ Width = 196
+ Height = 8
+ Cursor = crVSplit
+ Align = alTop
+ AutoSnap = False
+ Beveled = True
+ MinSize = 60
+ end
+ object image_txmppreview: TImage
+ Left = 2
+ Top = 198
+ Width = 196
+ Height = 119
+ Align = alClient
+ end
+ object list_txmp: TListBox
+ Left = 2
+ Top = 15
+ Width = 196
+ Height = 175
+ Align = alTop
+ ItemHeight = 13
+ TabOrder = 0
+ OnClick = list_txmpClick
+ end
+ object panel_txmppreview: TPanel
+ Left = 2
+ Top = 317
+ Width = 196
+ Height = 30
+ Align = alBottom
+ BevelOuter = bvNone
+ TabOrder = 1
+ object btn_save: TButton
+ Left = 2
+ Top = 2
+ Width = 111
+ Height = 25
+ Caption = 'Save TXMP-Picture'
+ TabOrder = 0
+ OnClick = btn_saveClick
+ end
+ end
+ end
+ object group_bmpselect: TGroupBox
+ Left = 208
+ Top = 0
+ Width = 186
+ Height = 349
+ Align = alClient
+ Caption = '2. Open BMP to replace with'
+ Enabled = False
+ TabOrder = 1
+ object image_bmppreview: TImage
+ Left = 2
+ Top = 45
+ Width = 182
+ Height = 302
+ Align = alClient
+ end
+ object panel_load: TPanel
+ Left = 2
+ Top = 15
+ Width = 182
+ Height = 30
+ Align = alTop
+ BevelOuter = bvNone
+ TabOrder = 0
+ object btn_load: TButton
+ Left = 2
+ Top = 2
+ Width = 121
+ Height = 25
+ Caption = 'Load BMP ...'
+ TabOrder = 0
+ OnClick = btn_loadClick
+ end
+ end
+ end
+ end
+ object group_options: TGroupBox
+ Left = 0
+ Top = 349
+ Width = 394
+ Height = 79
+ Align = alBottom
+ Caption = '3. Options && Replace'
+ Enabled = False
+ TabOrder = 1
+ object btn_replace: TButton
+ Left = 4
+ Top = 50
+ Width = 157
+ Height = 25
+ Caption = 'Replace'
+ TabOrder = 0
+ OnClick = btn_replaceClick
+ end
+ object check_transparency: TCheckBox
+ Left = 8
+ Top = 16
+ Width = 105
+ Height = 17
+ Caption = 'Transparency'
+ TabOrder = 1
+ end
+ object check_fading: TCheckBox
+ Left = 8
+ Top = 32
+ Width = 105
+ Height = 17
+ Caption = 'MIP Mapping'
+ TabOrder = 2
+ end
+ object check_32bit: TCheckBox
+ Left = 112
+ Top = 16
+ Width = 105
+ Height = 17
+ Hint = 'Import bitmap as 32bit image (to prevent from quality loss)'
+ Caption = '32bit'
+ ParentShowHint = False
+ ShowHint = True
+ TabOrder = 3
+ end
+ end
+ object opend: TOpenDialog
+ Filter = '24bit Bitmap (*.bmp)|*.bmp'
+ Options = [ofPathMustExist, ofFileMustExist, ofEnableSizing]
+ Left = 352
+ Top = 16
+ end
+ object saved: TSaveDialog
+ DefaultExt = 'bmp'
+ Filter = 'Windows Bitmap (*.bmp)|*.bmp'
+ Options = [ofOverwritePrompt, ofHideReadOnly, ofPathMustExist, ofEnableSizing]
+ Left = 104
+ Top = 320
+ end
+end
Index: oup/releases/0.30a/Unit7_txmpreplace.pas
===================================================================
--- oup/releases/0.30a/Unit7_txmpreplace.pas (revision 33)
+++ oup/releases/0.30a/Unit7_txmpreplace.pas (revision 33)
@@ -0,0 +1,225 @@
+UNIT Unit7_txmpreplace;
+INTERFACE
+USES
+ Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
+ Dialogs, ExtCtrls, StdCtrls, StrUtils, Unit2_functions, Unit3_data;
+
+TYPE
+ TForm7 = Class(TForm)
+ panel_12: TPanel;
+ group_txmpselect: TGroupBox;
+ splitter_txmp: TSplitter;
+ list_txmp: TListBox;
+ Splitter1: TSplitter;
+ group_bmpselect: TGroupBox;
+ panel_load: TPanel;
+ btn_load: TButton;
+ image_bmppreview: TImage;
+ opend: TOpenDialog;
+ group_options: TGroupBox;
+ btn_replace: TButton;
+ check_transparency: TCheckBox;
+ check_fading: TCheckBox;
+ check_32bit: TCheckBox;
+ panel_txmppreview: TPanel;
+ btn_save: TButton;
+ image_txmppreview: TImage;
+ saved: TSaveDialog;
+ PROCEDURE btn_saveClick(Sender: TObject);
+ PROCEDURE FormActivate(Sender: TObject);
+ PROCEDURE FormClose(Sender: TObject; var Action: TCloseAction);
+ PROCEDURE btn_replaceClick(Sender: TObject);
+ PROCEDURE btn_loadClick(Sender: TObject);
+ PROCEDURE list_txmpClick(Sender: TObject);
+ PROCEDURE FormResize(Sender: TObject);
+ PROCEDURE Recreatelist;
+ PRIVATE
+ PUBLIC
+ END;
+
+VAR
+ Form7: TForm7;
+
+IMPLEMENTATION
+USES Unit1_main, Unit6_imgfuncs, Unit15_Classes;
+{$R *.dfm}
+VAR
+ actual_bmpdata:Tdata;
+
+PROCEDURE TForm7.Recreatelist;
+ VAR
+ files:TStringArray;
+ i:LongWord;
+ BEGIN
+ list_txmp.Items.Clear;
+ files:=OniDataConnection.GetFilesList('TXMP','',True);
+ IF Length(files)>0 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:=OniDataConnection.GetFileIDByName(list_txmp.Items.Strings[list_txmp.ItemIndex]);
+
+ OniDataConnection.LoadDatFilePart(id,$88,SizeOf(fadingbyte),@fadingbyte);
+ OniDataConnection.LoadDatFilePart(id,$89,SizeOf(depthbyte),@depthbyte);
+ OniDataConnection.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;
+ 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:=OniDataConnection.GetFileIDByName(list_txmp.Items.Strings[list_txmp.ItemIndex]);
+ OniDataConnection.LoadDatFilePart(id,$8C,2,@oldwidth);
+ OniDataConnection.LoadDatFilePart(id,$8E,2,@oldheight);
+ OniDataConnection.LoadDatFilePart(id,$88,1,@oldfading);
+ OniDataConnection.LoadDatFilePart(id,$89,1,@olddepth);
+ OniDataConnection.LoadDatFilePart(id,$90,1,@oldstore);
+ OniDataConnection.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;
+
+ 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_fading.Checked THEN
+ IF Not CreateFadedImage(imgpkg,imgpkg.imgdata) THEN
+ IF MessageBox(Self.Handle, PChar('Can not create a MipMapped-image (probably because of a wrong dimension).'+#13+#10+'Do you want to continue without MipMapping?'), PChar('Warning'), MB_YESNO)=ID_YES THEN
+ check_fading.Checked:=False
+ ELSE
+ Exit;
+
+ 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) AND (OniDataConnection.Backend=ODB_Dat) THEN
+ new_rawaddr:=OniDataConnection.AppendRawFile(False,Length(imgpkg.imgdata),imgpkg.imgdata)
+ ELSE BEGIN
+ new_rawaddr:=old_rawaddr;
+ OniDataConnection.UpdateRawFile(id,$9C,Length(imgpkg.imgdata),imgpkg.imgdata);
+ END;
+
+ datbyte:=$00;
+ IF check_fading.Checked THEN datbyte:=datbyte OR $01;
+ OniDataConnection.UpdateDatFilePart(id,$88,1,@datbyte);
+ datbyte:=$10;
+ IF check_transparency.Checked THEN datbyte:=datbyte OR $04;
+ OniDataConnection.UpdateDatFilePart(id,$89,1,@datbyte);
+ OniDataConnection.UpdateDatFilePart(id,$8C,2,@imgpkg.imgx);
+ OniDataConnection.UpdateDatFilePart(id,$8E,2,@imgpkg.imgy);
+ IF check_32bit.Checked THEN
+ datbyte:=$08
+ ELSE
+ datbyte:=$01;
+ OniDataConnection.UpdateDatFilePart(id,$90,1,@datbyte);
+ OniDataConnection.UpdateDatFilePart(id,$9C,4,@new_rawaddr);
+
+ 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(OniDataConnection.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: oup/releases/0.30a/Unit8_binedit.dfm
===================================================================
--- oup/releases/0.30a/Unit8_binedit.dfm (revision 33)
+++ oup/releases/0.30a/Unit8_binedit.dfm (revision 33)
@@ -0,0 +1,385 @@
+object Form8: TForm8
+ Left = 0
+ Top = 0
+ BorderIcons = [biSystemMenu, biMaximize]
+ Caption = 'Binary .dat-Editor'
+ ClientHeight = 555
+ ClientWidth = 642
+ Color = clBtnFace
+ Font.Charset = DEFAULT_CHARSET
+ Font.Color = clWindowText
+ Font.Height = -11
+ Font.Name = 'Tahoma'
+ Font.Style = []
+ FormStyle = fsMDIChild
+ KeyPreview = True
+ OldCreateOrder = False
+ Visible = True
+ WindowState = wsMaximized
+ OnActivate = FormActivate
+ OnClose = FormClose
+ OnCloseQuery = FormCloseQuery
+ OnCreate = FormCreate
+ OnKeyUp = FormKeyUp
+ OnResize = FormResize
+ PixelsPerInch = 96
+ TextHeight = 13
+ object Splitter1: TSplitter
+ Left = 150
+ Top = 0
+ Width = 9
+ Height = 555
+ AutoSnap = False
+ Beveled = True
+ MinSize = 150
+ ExplicitHeight = 423
+ end
+ object panel_data: TPanel
+ Left = 159
+ Top = 0
+ Width = 483
+ Height = 555
+ Align = alClient
+ BevelOuter = bvNone
+ TabOrder = 0
+ object Splitter2: TSplitter
+ Left = 0
+ Top = 209
+ Width = 483
+ Height = 9
+ Cursor = crVSplit
+ Align = alTop
+ AutoSnap = False
+ Beveled = True
+ MinSize = 40
+ end
+ object Splitter3: TSplitter
+ Left = 0
+ Top = 450
+ Width = 483
+ Height = 8
+ Cursor = crVSplit
+ Align = alBottom
+ AutoSnap = False
+ Beveled = True
+ MinSize = 40
+ ExplicitTop = 375
+ end
+ object hex: TMPHexEditor
+ Left = 0
+ Top = 0
+ Width = 483
+ Height = 209
+ Cursor = crIBeam
+ Align = alTop
+ Font.Charset = DEFAULT_CHARSET
+ Font.Color = clWindowText
+ Font.Height = -16
+ Font.Name = 'Courier'
+ Font.Style = []
+ OnKeyUp = hexKeyUp
+ ParentFont = False
+ TabOrder = 0
+ BytesPerRow = 16
+ Translation = tkASCII
+ OffsetFormat = '6!10:0x|'
+ Colors.Background = clWindow
+ Colors.ChangedBackground = clWindow
+ Colors.ChangedText = clRed
+ Colors.CursorFrame = clNavy
+ Colors.Offset = clBlack
+ Colors.OddColumn = clBlue
+ Colors.EvenColumn = clNavy
+ Colors.CurrentOffsetBackground = clBtnShadow
+ Colors.OffsetBackGround = clBtnFace
+ Colors.CurrentOffset = clBtnHighlight
+ Colors.Grid = clBtnFace
+ Colors.NonFocusCursorFrame = clAqua
+ Colors.ActiveFieldBackground = clWindow
+ FocusFrame = True
+ NoSizeChange = True
+ AllowInsertMode = False
+ DrawGridLines = False
+ Version = 'May 23, 2005; '#169' markus stephany, vcl[at]mirkes[dot]de'
+ OnChange = hexChange
+ ShowPositionIfNotFocused = True
+ OnSelectionChanged = hexSelectionChanged
+ end
+ object value_viewer: TWrapGrid
+ Left = 0
+ Top = 218
+ Width = 483
+ Height = 232
+ Align = alClient
+ ColCount = 1
+ DefaultColWidth = 80
+ DefaultRowHeight = 18
+ FixedCols = 0
+ RowCount = 8
+ FixedRows = 0
+ Options = [goFixedVertLine, goFixedHorzLine, goVertLine, goHorzLine, goColSizing]
+ PopupMenu = value_viewer_context
+ TabOrder = 1
+ OnDblClick = value_viewerDblClick
+ OnMouseDown = value_viewerMouseDown
+ end
+ object VST: TVirtualStringTree
+ Left = 0
+ Top = 458
+ Width = 483
+ Height = 97
+ Align = alBottom
+ AnimationDuration = 0
+ AutoExpandDelay = 300
+ BiDiMode = bdLeftToRight
+ Colors.UnfocusedSelectionColor = clGradientActiveCaption
+ Colors.UnfocusedSelectionBorderColor = clGradientActiveCaption
+ Ctl3D = True
+ DragOperations = []
+ DrawSelectionMode = smBlendedRectangle
+ EditDelay = 200
+ Font.Charset = DEFAULT_CHARSET
+ Font.Color = clWindowText
+ Font.Height = -11
+ Font.Name = 'Tahoma'
+ Font.Style = []
+ Header.AutoSizeIndex = 0
+ Header.Font.Charset = DEFAULT_CHARSET
+ Header.Font.Color = clWindowText
+ Header.Font.Height = -11
+ Header.Font.Name = 'Tahoma'
+ Header.Font.Style = []
+ Header.Options = [hoColumnResize, hoDblClickResize, hoDrag, hoVisible]
+ Header.PopupMenu = VTHPopup
+ Header.Style = hsFlatButtons
+ HintAnimation = hatNone
+ HintMode = hmTooltip
+ Indent = 14
+ ParentBiDiMode = False
+ ParentCtl3D = False
+ ParentFont = False
+ ParentShowHint = False
+ ShowHint = True
+ TabOrder = 2
+ TreeOptions.MiscOptions = [toAcceptOLEDrop, toCheckSupport, toFullRepaintOnResize, toInitOnSave, toToggleOnDblClick, toWheelPanning]
+ TreeOptions.PaintOptions = [toShowButtons, toShowDropmark, toShowHorzGridLines, toShowRoot, toShowTreeLines, toShowVertGridLines, toUseBlendedImages]
+ TreeOptions.SelectionOptions = [toExtendedFocus, toFullRowSelect, toRightClickSelect]
+ OnDblClick = VSTDblClick
+ OnFocusChanged = VSTFocusChanged
+ OnGetText = VSTGetText
+ OnHeaderDragged = VSTHeaderDragged
+ Columns = <
+ item
+ MaxWidth = 300
+ MinWidth = 100
+ Options = [coEnabled, coParentBidiMode, coParentColor, coResizable, coShowDropMark, coVisible]
+ Position = 0
+ Spacing = 20
+ Width = 150
+ WideText = 'Name'
+ WideHint = 'Name of the item.'
+ end
+ item
+ MaxWidth = 110
+ MinWidth = 80
+ Options = [coDraggable, coEnabled, coParentBidiMode, coParentColor, coResizable, coShowDropMark, coVisible]
+ Position = 1
+ Spacing = 20
+ Width = 85
+ WideText = 'Offset'
+ WideHint = 'Offset of the data-item.'
+ end
+ item
+ MaxWidth = 110
+ MinWidth = 75
+ Options = [coDraggable, coEnabled, coParentBidiMode, coParentColor, coResizable, coShowDropMark, coVisible]
+ Position = 2
+ Width = 75
+ WideText = 'Type'
+ WideHint = 'Data type of the item.'
+ end
+ item
+ MaxWidth = 250
+ MinWidth = 80
+ Options = [coDraggable, coEnabled, coParentBidiMode, coParentColor, coResizable, coShowDropMark, coVisible]
+ Position = 3
+ Width = 100
+ WideText = 'Value'
+ WideHint = 'Value of the item.'
+ end
+ item
+ MaxWidth = 400
+ MinWidth = 80
+ Options = [coDraggable, coEnabled, coParentBidiMode, coParentColor, coResizable, coShowDropMark, coVisible]
+ Position = 4
+ Width = 400
+ WideText = 'Description'
+ end>
+ WideDefaultText = ''
+ end
+ end
+ object panel_files: TPanel
+ Left = 0
+ Top = 0
+ Width = 150
+ Height = 555
+ Align = alLeft
+ BevelOuter = bvNone
+ TabOrder = 1
+ object Bevel1: TBevel
+ Left = 0
+ Top = 491
+ Width = 150
+ Height = 6
+ Align = alBottom
+ Style = bsRaised
+ ExplicitTop = 359
+ end
+ object list: TListBox
+ Left = 0
+ Top = 0
+ Width = 150
+ Height = 388
+ Align = alClient
+ ItemHeight = 13
+ TabOrder = 0
+ OnClick = listClick
+ end
+ object panel_extension: TPanel
+ Left = 0
+ Top = 388
+ Width = 150
+ Height = 103
+ Align = alBottom
+ BevelOuter = bvNone
+ TabOrder = 1
+ 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 panel_imexport: TPanel
+ Left = 0
+ Top = 497
+ Width = 150
+ Height = 58
+ Align = alBottom
+ BevelOuter = bvNone
+ TabOrder = 2
+ OnResize = panel_imexportResize
+ object btn_export: TButton
+ Left = 4
+ Top = 4
+ Width = 142
+ Height = 25
+ Caption = 'Export to file...'
+ TabOrder = 0
+ OnClick = btn_exportClick
+ end
+ object btn_import: TButton
+ Left = 4
+ Top = 32
+ Width = 142
+ Height = 25
+ Caption = 'Import from file...'
+ TabOrder = 1
+ OnClick = btn_importClick
+ end
+ end
+ end
+ object opend: TOpenDialog
+ Options = [ofPathMustExist, ofFileMustExist, ofEnableSizing]
+ Left = 120
+ Top = 392
+ end
+ object saved: TSaveDialog
+ Options = [ofOverwritePrompt, ofPathMustExist, ofEnableSizing]
+ Left = 120
+ Top = 368
+ end
+ object value_viewer_context: TPopupMenu
+ AutoHotkeys = maManual
+ OnPopup = value_viewer_contextPopup
+ Left = 240
+ Top = 248
+ object value_viewer_context_copy: TMenuItem
+ Caption = 'Copy to &clipboard'
+ OnClick = value_viewer_context_copyClick
+ end
+ object value_viewer_context_copyasdec: TMenuItem
+ Caption = 'Copy to clipboard (as &dec)'
+ OnClick = value_viewer_context_copyClick
+ end
+ object value_viewer_context_copyasfloat: TMenuItem
+ Caption = 'Copy to clipboard (as &float)'
+ OnClick = value_viewer_context_copyClick
+ end
+ object value_viewer_context_copyasbitset: TMenuItem
+ Caption = 'Copy to clipboard (as &bitset)'
+ OnClick = value_viewer_context_copyClick
+ end
+ object value_viewer_context_copyasstring: TMenuItem
+ Caption = 'Copy to clipboard (as &string)'
+ OnClick = value_viewer_context_copyClick
+ end
+ object value_viewer_context_copyashex: TMenuItem
+ Caption = 'Copy to clipboard (as &hex)'
+ OnClick = value_viewer_context_copyClick
+ end
+ end
+ object VTHPopup: TVTHeaderPopupMenu
+ OnColumnChange = VTHPopupColumnChange
+ Left = 200
+ Top = 496
+ end
+end
Index: oup/releases/0.30a/Unit8_binedit.pas
===================================================================
--- oup/releases/0.30a/Unit8_binedit.pas (revision 33)
+++ oup/releases/0.30a/Unit8_binedit.pas (revision 33)
@@ -0,0 +1,871 @@
+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, Unit15_Classes,
+ 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 OniDataConnection.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 OniDataConnection.GetFileIDByName(list.Items.Strings[i])=fileid THEN BEGIN
+ list.ItemIndex:=i;
+ Break;
+ END;
+ Self.ClearStructViewer;
+ data:=OniDataConnection.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:TStringArray;
+ BEGIN
+ combo_extension.Items.Clear;
+ combo_extension.Items.Add('_All files_ ('+IntToStr(OniDataConnection.GetFilesCount)+')');
+ exts:=OniDataConnection.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:TStringArray;
+ 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:=OniDataConnection.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);
+ BEGIN
+ LoadFileNames;
+ END;
+
+PROCEDURE TForm8.check_filternameClick(Sender: TObject);
+ BEGIN
+ edit_filtername.Enabled:=NOT check_filtername.Checked;
+ LoadFileNames;
+ END;
+
+PROCEDURE TForm8.listClick(Sender: TObject);
+ BEGIN
+ LoadDat(OniDataConnection.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(OniDataConnection.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);
+ data.Description:=SubDesc;
+ END ELSE BEGIN
+ data.Caption:=SubName;
+ data.Description:=SubDesc;
+ data.Offset:=0;
+ data.Value:='';
+ END;
+ data.DataType:=0;
+ node:=AddVSTEntry(VST, nil, data);
+ data.Description:='';
+ 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 '+OniDataConnection.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;
+ OniDataConnection.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;
+ node:PVirtualNode;
+ pdata:PNodeData;
+ BEGIN
+ IF hex.DataSize>0 THEN BEGIN
+ WriteValues;
+ 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 (*.'+OniDataConnection.GetFileInfo(fileid).Extension+')|*.'+OniDataConnection.GetFileInfo(fileid).Extension+'|All files|*.*';
+ saved.DefaultExt:=OniDataConnection.GetFileInfo(fileid).Extension;
+ IF saved.Execute THEN BEGIN
+ ExportDatFile(fileid,saved.FileName);
+ END;
+ END;
+
+PROCEDURE TForm8.btn_importClick(Sender: TObject);
+ VAR
+ fs:TFileStream;
+ BEGIN
+ opend.Filter:='Files of matching extension (*.'+OniDataConnection.GetFileInfo(fileid).Extension+')|*.'+OniDataConnection.GetFileInfo(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
+ 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 OniDataConnection.GetRawInfo(fileid,nodedata.offset).raw_size>0 THEN BEGIN
+ IF Form1.open_child('rawedit') THEN BEGIN
+ TForm13(Form1.ActiveMDIChild).LoadRaw(OniDataConnection.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 OniDataConnection.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)
+ else
+ if data.Offset>0 then
+ CellText := '0x'+IntToHex(data.Offset,8);
+ 2:
+ if data.DataType>0 then
+ CellText := GetDataType(data.DataType);
+ 3:
+ if data.DataType>0 then
+ CellText := GetValue(data.DataType, data.Offset)
+ else
+ if Length(data.Value)>0 then
+ CellText := IntToStr(HexToLong(data.Value))+' Bytes';
+ 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: oup/releases/0.30a/Unit9_data_structures.pas
===================================================================
--- oup/releases/0.30a/Unit9_data_structures.pas (revision 33)
+++ oup/releases/0.30a/Unit9_data_structures.pas (revision 33)
@@ -0,0 +1,455 @@
+UNIT Unit9_data_structures;
+INTERFACE
+USES SysUtils, 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;
+ SubDesc: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;
+
+IMPLEMENTATION
+USES Unit2_functions, Unit15_Classes, 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 AGDB(fileid:LongWord):TRawList;
+ VAR
+ link:LongWord;
+ links:LongWord;
+ i:LongWord;
+ BEGIN
+ IF NOT dat_os_mac THEN BEGIN
+ OniDataConnection.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;
+ OniDataConnection.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
+ OniDataConnection.LoadDatFilePart(fileid,$1C,4,@links);
+ SetLength(Result,links);
+ FOR i:=0 TO links-1 DO BEGIN
+ Result[i].src_offset:=$20+i*$74+$24;
+ OniDataConnection.LoadDatFilePart(fileid,$20+i*$74+$24,4,@link);
+ Result[i].raw_addr:=link;
+ OniDataConnection.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
+ OniDataConnection.LoadDatFilePart(fileid,$0C,4,@link);
+ OniDataConnection.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
+ OniDataConnection.LoadDatFilePart(fileid,$08,4,@datasize);
+ OniDataConnection.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
+ OniDataConnection.LoadDatFilePart(fileid,$40,4,@datasize);
+ OniDataConnection.LoadDatFilePart(fileid,$44,4,@link);
+ Result[0].src_offset:=$44;
+ END ELSE BEGIN
+ OniDataConnection.LoadDatFilePart(fileid,$10,4,@datasize);
+ OniDataConnection.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,lastlink:LongWord;
+ links:LongWord;
+ i,j,k:LongWord;
+ data:Tdata;
+ BEGIN
+ OniDataConnection.LoadDatFilePart(fileid,$18,4,@baselink);
+ OniDataConnection.LoadDatFilePart(fileid,$1C,4,@links);
+ IF links>0 THEN BEGIN
+ OniDataConnection.LoadDatFilePart(fileid,$20+(links-1)*4,4,@lastlink);
+ SetLength(data,lastlink+1024);
+ TOniDataDat(OniDataConnection).LoadRawOffset(false, baselink,lastlink+1024,data);
+// OniDataConnection.LoadRawFile(fileid,$1C,baselink,lastlink+1024,False,@data[0]);
+ k:=0;
+ FOR j:=0 TO 1024 DO BEGIN
+ IF (data[lastlink+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:=lastlink+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);
+ OniDataConnection.LoadDatFilePart(fileid,$16C,2,@frames);
+ {y-pos}
+ OniDataConnection.LoadDatFilePart(fileid,$0C,4,@link);
+ Result[0].src_offset:=$0C;
+ Result[0].raw_addr:=link;
+ Result[0].raw_size:=frames*4;
+ {x-z-pos}
+ OniDataConnection.LoadDatFilePart(fileid,$10,4,@link);
+ Result[1].src_offset:=$10;
+ Result[1].raw_addr:=link;
+ Result[1].raw_size:=frames*8;
+ {attacks}
+ OniDataConnection.LoadDatFilePart(fileid,$182,1,@tempb);
+ OniDataConnection.LoadDatFilePart(fileid,$14,4,@link);
+ Result[2].src_offset:=$14;
+ Result[2].raw_addr:=link;
+ Result[2].raw_size:=tempb*32;
+ {damage}
+ OniDataConnection.LoadDatFilePart(fileid,$183,1,@tempb);
+ OniDataConnection.LoadDatFilePart(fileid,$18,4,@link);
+ Result[3].src_offset:=$18;
+ Result[3].raw_addr:=link;
+ Result[3].raw_size:=tempb*8;
+ {motionblur}
+ OniDataConnection.LoadDatFilePart(fileid,$184,1,@tempb);
+ OniDataConnection.LoadDatFilePart(fileid,$1C,4,@link);
+ Result[4].src_offset:=$1C;
+ Result[4].raw_addr:=link;
+ Result[4].raw_size:=tempb*8;
+ {shortcut}
+ OniDataConnection.LoadDatFilePart(fileid,$185,1,@tempb);
+ OniDataConnection.LoadDatFilePart(fileid,$20,4,@link);
+ Result[5].src_offset:=$20;
+ Result[5].raw_addr:=link;
+ Result[5].raw_size:=tempb*8;
+ {throw}
+ OniDataConnection.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}
+ OniDataConnection.LoadDatFilePart(fileid,$186,1,@tempb);
+ OniDataConnection.LoadDatFilePart(fileid,$28,4,@link);
+ Result[7].src_offset:=$28;
+ Result[7].raw_addr:=link;
+ Result[7].raw_size:=tempb*4;
+ {particle}
+ OniDataConnection.LoadDatFilePart(fileid,$187,1,@tempb);
+ OniDataConnection.LoadDatFilePart(fileid,$2C,4,@link);
+ Result[8].src_offset:=$2C;
+ Result[8].raw_addr:=link;
+ Result[8].raw_size:=tempb*24;
+ {position}
+ OniDataConnection.LoadDatFilePart(fileid,$30,4,@link);
+ Result[9].src_offset:=$30;
+ Result[9].raw_addr:=link;
+ Result[9].raw_size:=frames*8;
+ {particle}
+ OniDataConnection.LoadDatFilePart(fileid,$154,2,@tempw);
+ OniDataConnection.LoadDatFilePart(fileid,$38,4,@link);
+ Result[11].src_offset:=$38;
+ Result[11].raw_addr:=link;
+ Result[11].raw_size:=tempw*34;
+ {extent}
+ OniDataConnection.LoadDatFilePart(fileid,$138,4,@templ);
+ OniDataConnection.LoadDatFilePart(fileid,$13C,4,@link);
+ Result[12].src_offset:=$13C;
+ Result[12].raw_addr:=link;
+ Result[12].raw_size:=templ*12;
+
+ OniDataConnection.LoadDatFilePart(fileid,$34,4,@link);
+ tempw:=0;
+ IF link>0 THEN BEGIN
+ {BODY ANIMATIONS PART DECODE!!!}
+ SetLength(data,$FFFF);
+ TOniDataDat(OniDataConnection).LoadRawOffset(false,link,$FFFF,data);
+// OniDataConnection.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
+ OniDataConnection.LoadDatFilePart(fileid,$8C,SizeOf(x),@x);
+ OniDataConnection.LoadDatFilePart(fileid,$8E,SizeOf(y),@y);
+ OniDataConnection.LoadDatFilePart(fileid,$90,SizeOf(storetype),@storetype);
+ OniDataConnection.LoadDatFilePart(fileid,$9C,4,@link_pc);
+ OniDataConnection.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:TStringArray;
+ filename:String;
+ ext:String[4];
+ temps:String;
+ data:TData;
+ BEGIN
+ SetLength(Result.Global,0);
+ SetLength(Result.Subs,0);
+ Result.Data:=False;
+ ext:=OniDataConnection.GetFileInfo(fileid).Extension;
+ filename:=ExtractFilePath(Application.ExeName)+'\StructDefs\'+ext+'.txt';
+ IF FileExists(filename) THEN BEGIN
+ data:=OniDataConnection.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) AND (temps[1]<>'#') THEN BEGIN
+ IF temps[1]='*' THEN BEGIN
+ fields:=Explode(temps,#9);
+ CASE Length(fields) OF
+ 1..2: 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);
+ IF Length(fields)=2 THEN
+ Result.Subs[High(Result.Subs)].SubDesc:=fields[1];
+ END;
+ 3: BEGIN
+ current_type:=1;
+ current_base:=HexToLong(fields[2]);
+ SetLength(Result.Subs, Length(Result.Subs)+1);
+ Result.Subs[High(Result.Subs)].SubName:=MidStr(fields[0],2,Length(fields[0])-1);
+ Result.Subs[High(Result.Subs)].SubDesc:=fields[1];
+ END;
+ 6: BEGIN
+ current_type:=2;
+ current_base:=HexToLong(fields[2]);
+ current_package:=0;
+ current_package_size:=StrToInt(fields[5]);
+ IF fields[4][1]<>'$' THEN BEGIN
+ CASE StrToInt(fields[4]) OF
+ 1: packages:=data[HexToLong(fields[3])];
+ 2: packages:=data[HexToLong(fields[3])]+data[HexToLong(fields[3])+1]*256;
+ 4: packages:=data[HexToLong(fields[3])]+data[HexToLong(fields[3])+1]*256+data[HexToLong(fields[3])+2]*256*256+data[HexToLong(fields[3])+3]*256*256*256;
+ END;
+ END ELSE BEGIN
+ packages:=HexToLong(fields[4]);
+ 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);
+ Result.Subs[High(Result.Subs)-packages+current_package+1].SubDesc:=
+ fields[1];
+ 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.