source: oup/current/Helper/LevelDB.pas @ 150

Last change on this file since 150 was 150, checked in by alloc, 14 years ago
File size: 24.2 KB
Line 
1unit LevelDB;
2interface
3uses
4  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
5  Dialogs, ComCtrls, StdCtrls, StrUtils;
6
7type
8  TForm_LevelDB = class(TForm)
9    group_progress: TGroupBox;
10    progress:     TProgressBar;
11    lbl_progress: TLabel;
12    btn_abortok:  TButton;
13    lbl_estimation: TLabel;
14    procedure btn_abortokClick(Sender: TObject);
15  public
16    procedure CreateDatabase(Source, Target: String);
17    procedure CreateLevel(Source, Target: String);
18  end;
19
20
21var
22  Form_LevelDB: TForm_LevelDB;
23
24implementation
25{$R *.dfm}
26uses ABSMain, ABSDecUtil, Main,
27    ConnectionManager, TypeDefs, DataAccess, OniImgClass, Data, RawList;
28
29var
30  Converting:  Boolean = False;
31  Abort:       Boolean = False;
32
33
34function GetOpenMsg(msg: TStatusMessages): String;
35begin
36  case msg of
37    SM_AlreadyOpened:    Result := 'File already opened.';
38    SM_FileNotFound:     Result := 'File not found.';
39    SM_UnknownExtension: Result := 'Unknown extension.';
40    SM_IncompatibleFile: Result := 'Incompatible file format.';
41    SM_UnknownError:     Result := 'Unknown error.';
42  end;
43end;
44
45
46procedure TForm_LevelDB.CreateLevel(Source, Target: String);
47const
48  EmptyBytes: Array[0..31] of Byte = (
49      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,0,0,0,0,0,0,0 );
50var
51  DatHeader:        THeader;
52  FilesHeader:      TFilesMap;
53  NamedFilesHeader: TNamedFilesMap;
54  ExtensionsHeader: TExtensionsMap;
55
56  Stream_Body, Stream_Names:          TMemoryStream;
57  Stream_Dat, Stream_Raw, Stream_Sep: TFileStream;
58
59  BeginTime, FileTime: Double;
60  Step:     Integer;
61  LevelID:    Integer;
62  TimeFormat: TFormatSettings;
63
64  ConID:      Integer;
65  Connection: TDataAccess;
66  ConRepMsg:  TStatusMessages;
67
68  FileID:     Integer;
69
70  Strings:    TStrings;
71  i, j:       Integer;
72  temps:      String;
73  tempi:      Integer;
74  tempb:      Byte;
75  FileInfo:   TFileInfo;
76  DatLinks:   TDatLinkList;
77  RawLinks:   TRawDataList;
78
79  DatFileStream, RawFileStream: TMemoryStream;
80const
81  Steps: Byte = 3;
82
83
84  procedure DoStep(StepName: String);
85  begin
86    Inc(Step);
87    if StepName <> 'FIN' then
88      group_progress.Caption :=
89        'Creating Dat (Step ' + IntToStr(Step) + '/' + IntToStr(Steps) + ': ' + StepName + ')'
90    else
91      group_progress.Caption := 'Creating Dat (FINISHED)';
92  end;
93
94  procedure StopConvert;
95  begin
96    btn_abortok.Caption := '&Close';
97    btn_abortok.Default := True;
98    converting := False;
99    lbl_estimation.Caption := 'ABORTED';
100    group_progress.Caption := 'Creating Level (ABORTED)';
101
102    Stream_Body.Free;
103    Stream_Names.Free;
104    DatFileStream.Free;
105    RawFileStream.Free;
106   
107    Stream_Dat.Free;
108    Stream_Raw.Free;
109    if Connection.DataOS in [DOS_WINDEMO, DOS_MAC, DOS_MACBETA] then
110      Stream_Sep.Free;
111   
112    if MessageBox(Self.Handle, PChar('Delete the unfinished level-files?'),
113      PChar('Delete files?'), MB_YESNO) = idYes then
114    begin
115      DeleteFile(target);
116      DeleteFile(AnsiReplaceStr(Target, '.dat', '.raw'));
117      if Connection.DataOS in [DOS_WINDEMO, DOS_MAC, DOS_MACBETA] then
118        DeleteFile(AnsiReplaceStr(Target, '.dat', '.sep'));
119    end;
120  end;
121
122begin
123
124  //
125  // FILE EXISTS CHECK FÜR DAT/RAW/SEP!!!
126  //
127
128  TimeFormat.ShortTimeFormat := 'hh:nn:ss';
129  TimeFormat.LongTimeFormat  := 'hh:nn:ss';
130  TimeFormat.TimeSeparator   := ':';
131
132  ConID := ConManager.OpenConnection(Source, ConRepMsg);
133  if not (ConRepMsg in [SM_OK, SM_AlreadyOpened]) then
134  begin
135    ShowMessage('Source-file couldn''t be opened! Aborting' + CrLf + GetOpenMsg(ConRepMsg));
136    Exit;
137  end else
138    Connection := ConManager.Connection[ConID];
139
140  ConID := ConManager.FileOpened(Target);
141  if ConID >= 0 then
142  begin
143    if MessageBox(Self.Handle, PChar('Destination-file is opened, close it in ' +
144          'order to proceed conversion?'), PChar('Destination-file opened'),
145          MB_YESNO + MB_ICONQUESTION) = ID_YES then
146    begin
147      if Form_Main.CheckConnectionCloseable(ConID) then
148        if not ConManager.CloseConnection(ConID, ConRepMsg) then
149        begin
150          ShowMessage('Couldn''t close destination-file. Aborting');
151          Exit;
152        end;
153    end else begin
154      ShowMessage('Aborting');
155      Exit;
156    end;
157  end;
158
159  if FileExists(Target) then
160  begin
161    if MessageBox(Self.Handle, PChar('Destination-file exists. ' +
162          'Overwrite it?'), PChar('Destination-file exists'),
163          MB_YESNO + MB_ICONWARNING) = ID_YES then
164    begin
165      if not DeleteFile(Target) then
166      begin
167        ShowMessage('Couldn''t delete file. Aborting');
168        Exit;
169      end;
170      if FileExists(AnsiReplaceStr(Target, '.dat', '.raw')) then
171        if not DeleteFile(AnsiReplaceStr(Target, '.dat', '.raw')) then
172        begin
173          ShowMessage('Couldn''t delete file. Aborting');
174          Exit;
175        end;
176      if FileExists(AnsiReplaceStr(Target, '.dat', '.sep')) then
177        if Connection.DataOS in [DOS_WINDEMO, DOS_MAC, DOS_MACBETA] then
178          if not DeleteFile(AnsiReplaceStr(Target, '.dat', '.sep')) then
179          begin
180            ShowMessage('Couldn''t delete file. Aborting');
181            Exit;
182          end;
183    end else begin
184      ShowMessage('Aborting');
185      Exit;
186    end;
187  end;
188
189  LevelID  := Connection.LevelNumber;
190  LevelID  := (LevelID * 2) * 256 * 256 * 256 + $01;
191
192  Self.Visible := True;
193  Form_Main.Visible := False;
194  Step := 0;
195  Converting := True;
196  Abort := False;
197  btn_abortok.Caption := '&Abort...';
198  btn_abortok.Default := False;
199  BeginTime := Time;
200
201  Stream_Body  := TMemoryStream.Create;
202  Stream_Names := TMemoryStream.Create;
203  Stream_Dat   := TFileStream.Create(Target, fmCreate);
204  Stream_Raw   := TFileStream.Create(AnsiReplaceStr(Target, '.dat', '.raw'), fmCreate);
205  if Connection.DataOS in [DOS_WINDEMO, DOS_MAC, DOS_MACBETA] then
206    Stream_Sep := TFileStream.Create(AnsiReplaceStr(Target, '.dat', '.sep'), fmCreate);
207
208  DoStep('Creating header');
209  progress.Position      := 0;
210  lbl_progress.Caption   := '';
211  lbl_estimation.Caption := 'Estimated finishing time: unknown';
212  Application.ProcessMessages;
213
214  SetLength(NamedFilesHeader, 0);
215  Strings := TStringList.Create;
216  Strings := Connection.GetFilesList('', '', False, ST_ExtNameAsc);
217  for i := 0 to Strings.Count - 1 do
218  begin
219    if MidStr(Strings.Strings[i],
220          Pos('-', Strings.Strings[i]) + 1,
221          Length(Strings.Strings[i]) -
222            Pos('.', ReverseString(Strings.Strings[i])) -
223            Pos('-', Strings.Strings[i])
224        ) <> '' then
225    begin
226      SetLength(NamedFilesHeader, Length(NamedFilesHeader) + 1);
227      NamedFilesHeader[High(NamedFilesHeader)].FileNumber := StrToInt(MidStr(Strings.Strings[i], 1, 5));
228      NamedFilesHeader[High(NamedFilesHeader)].blubb := 0;
229    end;
230  end;
231
232  for i := 0 to High(DatHeader.OSIdent) do
233    case Connection.DataOS of
234      DOS_WIN: DatHeader.OSIdent[i] := HeaderOSIdentWin[i];
235      DOS_MAC: DatHeader.OSIdent[i] := HeaderOSIdentMac[i];
236      DOS_MACBETA: DatHeader.OSIdent[i] := HeaderOSIdentMacBeta[i];
237    end;
238  for i := 0 to High(DatHeader.GlobalIdent) do
239    DatHeader.GlobalIdent[i] := HeaderGlobalIdent[i];
240  DatHeader.Files := Connection.GetFileCount;
241  DatHeader.NamedFiles := Length(NamedFilesHeader);
242
243  Strings := Connection.GetExtensionsList(EF_ExtCount);
244
245  DatHeader.Extensions := Strings.Count;
246  DatHeader.DataAddr   := 0;
247  DatHeader.DataSize   := 0;
248  DatHeader.NamesAddr  := 0;
249  DatHeader.NamesSize  := 0;
250  for i := 0 to High(DatHeader.Ident2) do
251    DatHeader.Ident2[i] := 0;
252  SetLength(FilesHeader, DatHeader.Files);
253  SetLength(ExtensionsHeader, DatHeader.Extensions);
254
255
256  DoStep('Writing extensions-header');
257  progress.Max := Strings.Count;
258  Application.ProcessMessages;
259  for i := 0 to Strings.Count - 1 do
260  begin
261    temps := Strings.Strings[i];
262    ExtensionsHeader[i].ExtCount := StrToInt( MidStr(
263            temps,
264            Pos('(', temps) + 1,
265            Pos(')', temps) - Pos('(', temps) - 1 ) );
266    temps := MidStr(temps, 1, 4);
267    for j := 0 to 3 do
268      ExtensionsHeader[i].Extension[j] := temps[4-j];
269    for j := 0 to High(FileTypes) do
270      if FileTypes[j].Extension = temps then
271        Break;
272    if j < Length(FileTypes) then
273    begin
274      case Connection.DataOS of
275        DOS_WIN:     ExtensionsHeader[i].Ident := FileTypes[j].IdentWin;
276        DOS_WINDEMO: ExtensionsHeader[i].Ident := FileTypes[j].IdentMac;
277        DOS_MAC:     ExtensionsHeader[i].Ident := FileTypes[j].IdentMac;
278        DOS_MACBETA: ExtensionsHeader[i].Ident := FileTypes[j].IdentMac;
279      end;
280    end else begin
281      ShowMessage('Unknown Extension: ' + Strings.Strings[i]);
282      Exit;
283    end;
284    progress.Position    := i + 1;
285    lbl_progress.Caption := 'Extensions done: ' + IntToStr(i + 1) + '/' +
286      IntToStr(Strings.Count);
287    Application.ProcessMessages;
288  end;
289
290  DoStep('Storing files-data');
291  progress.Position := 0;
292  progress.Max      := DatHeader.Files;
293  lbl_progress.Caption := '';
294  lbl_estimation.Caption := 'Estimated finishing time: unknown';
295  Application.ProcessMessages;
296
297  FileTime := Time;
298  for FileID := 0 to DatHeader.Files - 1 do
299  begin
300    FileInfo := Connection.GetFileInfo(FileID);
301    for j := 0 to 3 do
302      FilesHeader[FileID].Extension[j] := FileInfo.Extension[4 - j];
303    if FileInfo.Size > 0 then
304    begin
305      FilesHeader[FileID].DataAddr := Stream_Body.Size + 8;
306      DatFileStream := TMemoryStream.Create;
307      Connection.LoadDatFile(FileID, TStream(DatFileStream));
308      DatFileStream.Seek(0, soFromBeginning);
309      tempi := FileID * 256 + 1;
310      DatFileStream.Write(tempi, 4);
311      DatFileStream.Write(LevelID, 4);
312
313      DatLinks := Connection.GetDatLinks(FileID);
314      if Length(DatLinks) > 0 then
315      begin
316        for i := 0 to High(DatLinks) do
317        begin
318          DatFileStream.Seek(DatLinks[i].SrcOffset, soFromBeginning);
319          if DatLinks[i].DestID < 0 then
320            tempi := 0
321          else
322            tempi := DatLinks[i].DestID * 256 + 1;
323          DatFileStream.Write(tempi, 4);
324        end;
325      end;
326
327      RawLinks := Connection.GetRawList(FileID);
328      if Length(RawLinks) > 0 then
329      begin
330        for i := 0 to High(RawLinks) do
331        begin
332          if RawLinks[i].RawSize > 0 then
333          begin
334            RawFileStream := TMemoryStream.Create;
335            Connection.LoadRawFile(FileID, RawLinks[i].SrcOffset, TStream(RawFileStream));
336            RawFileStream.Seek(0, soFromBeginning);
337            if RawLinks[i].LocSep then
338            begin
339              RawLinks[i].RawAddr := Stream_Sep.Size;
340              Stream_sep.CopyFrom(RawFileStream, RawFileStream.Size);
341              if (Stream_Sep.Size mod 32) > 0 then
342                Stream_Sep.Write(EmptyBytes[0], 32 - (Stream_Sep.Size mod 32));
343            end else begin
344              RawLinks[i].RawAddr := Stream_Raw.Size;
345              Stream_Raw.CopyFrom(RawFileStream, RawFileStream.Size);
346              if (Stream_Raw.Size mod 32) > 0 then
347                Stream_Raw.Write(EmptyBytes[0], 32 - (Stream_Raw.Size mod 32));
348            end;
349          end else
350            RawLinks[i].RawAddr := 0;
351          DatFileStream.Seek(RawLinks[i].SrcOffset, soFromBeginning);
352          DatFileStream.Write(RawLinks[i].RawAddr, 4);
353        end;
354      end;
355      DatFileStream.Seek(0, soFromBeginning);
356      Stream_Body.CopyFrom(DatFileStream, DatFileStream.Size);
357      if (Stream_Body.Size mod 32) > 0 then
358      begin
359        ShowMessage(
360            IntToStr(FileID) + '-' + FileInfo.Name + '.' + FileInfo.Extension + #13#10 +
361            IntToStr(Stream_Body.Size));
362        Stream_Body.Write(EmptyBytes[0], 32 - (Stream_Body.Size mod 32));
363      end;
364    end
365    else
366      FilesHeader[FileID].DataAddr := 0;
367    if Length(fileinfo.Name) > 0 then
368    begin
369      FilesHeader[FileID].NameAddr := Stream_Names.Size;
370      temps := fileinfo.Extension + fileinfo.Name + Chr(0);
371      Stream_Names.Write(temps[1], Length(temps));
372    end
373    else
374      FilesHeader[FileID].NameAddr := 0;
375    FilesHeader[FileID].FileSize := fileinfo.Size;
376    FilesHeader[FileID].FileType := fileinfo.FileType;
377
378    if ((FileID mod 10) = 0) and (FileID >= 100) then
379      lbl_estimation.Caption := 'Estimated time left: ' + TimeToStr(
380        (Time - FileTime) / FileID * (progress.Max - FileID + 1) * 1.1, TimeFormat );
381    progress.Position := FileID + 1;
382    lbl_progress.Caption := 'Files done: ' + IntToStr(FileID + 1) + '/' + IntToStr(progress.Max);
383    Application.ProcessMessages;
384  end;
385
386  Stream_Dat.Write(DatHeader, SizeOf(DatHeader));
387  for i := 0 to High(FilesHeader) do
388    Stream_Dat.Write(FilesHeader[i], SizeOf(FilesHeader[i]));
389  for i := 0 to High(NamedFilesHeader) do
390    Stream_Dat.Write(NamedFilesHeader[i], SizeOf(NamedFilesHeader[i]));
391  for i := 0 to High(ExtensionsHeader) do
392    Stream_Dat.Write(ExtensionsHeader[i], SizeOf(ExtensionsHeader[i]));
393
394  if (Stream_Dat.Size mod 32) > 0 then
395    Stream_Dat.Write(EmptyBytes[0], 32 - (Stream_Dat.Size mod 32));
396
397  DatHeader.DataSize  := Stream_Body.Size;
398  DatHeader.NamesSize := Stream_Names.Size;
399  DatHeader.DataAddr  := Stream_Dat.Size;
400
401  Stream_Body.Seek(0, soFromBeginning);
402  Stream_Dat.CopyFrom(Stream_Body, Stream_Body.Size);
403
404  if (Stream_Dat.Size mod 32) > 0 then
405    Stream_Dat.Write(EmptyBytes[0], 32 - (Stream_Dat.Size mod 32));
406
407  DatHeader.NamesAddr := Stream_Dat.Size;
408  Stream_Names.Seek(0, soFromBeginning);
409  Stream_Dat.CopyFrom(Stream_Names, Stream_Names.Size);
410
411  Stream_Dat.Seek(0, soFromBeginning);
412  Stream_Dat.Write(DatHeader, SizeOf(DatHeader));
413
414  Stream_Dat.Free;
415  Stream_Body.Free;
416  Stream_Names.Free;
417  Stream_Raw.Free;
418
419  if Connection.DataOS in [DOS_WINDEMO, DOS_MAC, DOS_MACBETA] then
420    Stream_Sep.Free;
421
422  progress.Position      := progress.Max;
423  lbl_progress.Caption   := 'Files done: ' + IntToStr(progress.Max) + '/' +
424    IntToStr(progress.Max);
425  lbl_estimation.Caption := 'FINISHED (duration: ' + TimeToStr(Time - Begintime, TimeFormat) + ')';
426
427  DoStep('FIN');
428  btn_abortok.Caption := '&OK';
429  btn_abortok.Default := True;
430
431  converting := False;
432
433//  CloseDataConnection(DataConnections[conIndex]);
434end;
435
436
437
438
439procedure TForm_LevelDB.CreateDatabase(Source, target: String);
440var
441  DataBase:  TABSDatabase;
442  Query:     TABSQuery;
443  MimeCoder: TStringFormat_MIME64;
444
445  BeginTime, FileTime: Double;
446  Step:       Integer;
447  TimeFormat: TFormatSettings;
448
449  ConID:      Integer;
450  Connection: TDataAccess;
451  ConRepMsg:  TStatusMessages;
452
453  FileID:     Integer;
454
455  i:          Integer;
456  temps:      String;
457  tempdata:   TByteData;
458  FileInfo:   TFileInfo;
459  DatLinks:   TDatLinkList;
460  RawLinks:   TRawDataList;
461const
462  steps: Byte = 2;
463
464  procedure DoStep(stepname: String);
465  begin
466    Inc(step);
467    if stepname <> 'FIN' then
468      group_progress.Caption :=
469        'Creating DB (Step ' + IntToStr(step) + '/' + IntToStr(steps) + ': ' + stepname + ')'
470    else
471      group_progress.Caption := 'Creating DB (FINISHED)';
472  end;
473
474  procedure StopConvert;
475  begin
476    btn_abortok.Caption := '&Close';
477    btn_abortok.Default := True;
478    converting := False;
479    lbl_estimation.Caption := 'ABORTED';
480    group_progress.Caption := 'Creating DB (ABORTED)';
481    DataBase.Close;
482    if MessageBox(Self.Handle, PChar('Delete the unfinished DB-file?'),
483      PChar('Delete file?'), MB_YESNO) = idYes then
484    begin
485      DeleteFile(target);
486    end;
487end;
488
489
490
491begin
492
493  //
494  // FILE EXISTS CHECK FÜR DAT/RAW/SEP!!!
495  //
496
497  TimeFormat.ShortTimeFormat := 'hh:nn:ss';
498  TimeFormat.LongTimeFormat  := 'hh:nn:ss';
499  TimeFormat.TimeSeparator   := ':';
500
501  ConID := ConManager.OpenConnection(Source, ConRepMsg);
502  if not (ConRepMsg in [SM_OK, SM_AlreadyOpened]) then
503  begin
504    ShowMessage('Source-file couldn''t be opened! Aborting' + CrLf + GetOpenMsg(ConRepMsg));
505    Exit;
506  end else
507    Connection := ConManager.Connection[ConID];
508
509  ConID := ConManager.FileOpened(Target);
510  if ConID >= 0 then
511  begin
512    if MessageBox(Self.Handle, PChar('Destination-file is opened, close it in ' +
513          'order to proceed conversion?'), PChar('Destination-file opened'),
514          MB_YESNO + MB_ICONQUESTION) = ID_YES then
515    begin
516      if Form_Main.CheckConnectionCloseable(ConID) then
517        if not ConManager.CloseConnection(ConID, ConRepMsg) then
518        begin
519          ShowMessage('Couldn''t close destination-file. Aborting');
520          Exit;
521        end;
522    end else begin
523      ShowMessage('Aborting');
524      Exit;
525    end;
526  end;
527
528  if FileExists(Target) then
529  begin
530    if MessageBox(Self.Handle, PChar('Destination-file exists. ' +
531          'Overwrite it?'), PChar('Destination-file exists'),
532          MB_YESNO + MB_ICONWARNING) = ID_YES then
533    begin
534      if not DeleteFile(Target) then
535      begin
536        ShowMessage('Couldn''t delete file. Aborting');
537        Exit;
538      end;
539    end else begin
540      ShowMessage('Aborting');
541      Exit;
542    end;
543  end;
544
545  Self.Visible := True;
546  Form_Main.Visible := False;
547  step  := 0;
548  converting := True;
549  abort := False;
550  btn_abortok.Caption := '&Abort...';
551  btn_abortok.Default := False;
552
553  BeginTime := Time;
554
555  DataBase := TABSDatabase.Create(Self);
556  DataBase.MaxConnections := 1;
557  DataBase.PageSize := 8112;
558  DataBase.PageCountInExtent := 8;
559
560  DataBase.DatabaseName := 'OLDB';
561  DataBase.DatabaseFileName := target;
562  DataBase.CreateDatabase;
563
564  DoStep('Creating tables');
565  progress.Position      := 0;
566  lbl_progress.Caption   := '';
567  lbl_estimation.Caption := 'Estimated finishing time: unknown';
568  Application.ProcessMessages;
569
570  Query := TABSQuery.Create(Self);
571  Query.DatabaseName := 'OLDB';
572  Query.SQL.Text :=
573    'CREATE TABLE globals  ( id AUTOINC PRIMARY KEY, name STRING(128), ' +
574    'value STRING(128) );';
575  Query.ExecSQL;
576  Query.SQL.Text :=
577    'CREATE TABLE linkmap  ( id AUTOINC PRIMARY KEY, src_id INTEGER, ' +
578    'src_link_offset INTEGER, target_id INTEGER);';
579  Query.ExecSQL;
580  Query.SQL.Text := 'CREATE INDEX idsrcid ON linkmap (src_id);';
581  Query.ExecSQL;
582  Query.SQL.Text := 'CREATE INDEX idtargetid ON linkmap (target_id);';
583  Query.ExecSQL;
584  Query.SQL.Text :=
585    'CREATE TABLE rawmap  ( id AUTOINC PRIMARY KEY, src_id INTEGER, ' +
586    'src_link_offset INTEGER, sep BOOLEAN, size INTEGER, ' +
587    'data BLOB BlobCompressionMode 9 BlobBlockSize 1024 BlobCompressionAlgorithm ZLib);';
588  //    Query.SQL.Text:='CREATE TABLE rawmap  ( id AUTOINC PRIMARY KEY, src_id INTEGER, src_link_offset INTEGER, size INTEGER, data BLOB BlobCompressionAlgorithm None );';
589  Query.ExecSQL;
590  Query.SQL.Text := 'CREATE INDEX idsrcid ON rawmap (src_id);';
591  Query.ExecSQL;
592  Query.SQL.Text :=
593    'CREATE TABLE datfiles  ( id INTEGER PRIMARY KEY, extension CHAR(4), ' +
594    'name STRING(128), contenttype INTEGER, size INTEGER, ' +
595    'data BLOB BlobCompressionMode 9 BlobBlockSize 1024 BlobCompressionAlgorithm ZLib );';
596  //    Query.SQL.Text:='CREATE TABLE datfiles  ( id INTEGER PRIMARY KEY, extension CHAR(4), name STRING(128), contenttype INTEGER, size INTEGER, data BLOB BlobCompressionAlgorithm None );';
597  Query.ExecSQL;
598//  Query.SQL.Text :=
599//    'CREATE TABLE extlist  ( id AUTOINC PRIMARY KEY, ext CHAR(4), ident CHAR(16) );';
600//  Query.ExecSQL;
601
602  Query.SQL.Text := 'INSERT INTO globals (name,value) VALUES ("dbversion","' +
603    dbversion + '");';
604  Query.ExecSQL;
605
606  Query.SQL.Text := 'INSERT INTO globals (name,value) VALUES ("lvl","' +
607    IntToStr(Connection.LevelNumber) + '");';
608  Query.ExecSQL;
609  case Connection.DataOS of
610    DOS_WIN: temps := 'WIN';
611    DOS_WINDEMO: temps := 'WINDEMO';
612    DOS_MAC: temps := 'MAC';
613    DOS_MACBETA: temps := 'MACBETA';
614  end;
615  Query.SQL.Text := 'INSERT INTO globals (name,value) VALUES ("os","' + temps + '");';
616  Query.ExecSQL;
617
618  progress.Position      := 0;
619  lbl_progress.Caption   := 'Files done: ' + IntToStr(0) + '/' + IntToStr(
620    Connection.GetFileCount);
621  lbl_estimation.Caption := 'Estimated finishing time: unknown';
622
623  progress.Max := Connection.GetFileCount;
624  begintime    := Time;
625  DoStep('Writing .dat-fileslist');
626  Application.ProcessMessages;
627
628  FileTime := Time;
629  Database.StartTransaction;
630  for FileID := 0 to Connection.GetFileCount - 1 do
631  begin
632    fileinfo := Connection.GetFileInfo(FileID);
633    if (fileinfo.FileType and $02) = 0 then
634    begin
635      mimecoder := TStringFormat_MIME64.Create;
636      Connection.LoadDatFile(FileID, tempdata);
637      Query.SQL.Text :=
638        'INSERT INTO datfiles (id,extension,name,contenttype,size,data) VALUES (' +
639        IntToStr(FileID) + ',"' + fileinfo.Extension + '","' + fileinfo.Name + '","' + IntToHex(
640        fileinfo.FileType, 8) + '",' + IntToStr(fileinfo.Size) + ',MimeToBin("' +
641        MimeCoder.StrTo(@tempdata[0], Length(tempdata)) + '") );';
642      Query.ExecSQL;
643      mimecoder.Free;
644
645      RawLinks := Connection.GetRawList(FileID);
646      if Length(RawLinks) > 0 then
647      begin
648        for i := 0 to High(RawLinks) do
649        begin
650          if RawLinks[i].RawSize > 0 then
651          begin
652            SetLength(tempdata, RawLinks[i].RawSize);
653            Connection.LoadRawFile(FileID, RawLinks[i].SrcOffset, tempdata);
654            mimecoder      := TStringFormat_MIME64.Create;
655            Query.SQL.Text :=
656              'INSERT INTO rawmap (src_id,src_link_offset,sep,size,data) VALUES (' +
657              IntToStr(FileID) + ', ' + IntToStr(RawLinks[i].SrcOffset) + ',' +
658              BoolToStr(RawLinks[i].LocSep) + ', ' +
659              IntToStr(RawLinks[i].RawSize) + ', ' +
660              'MimeToBin("' + MimeCoder.StrTo(@tempdata[0], RawLinks[i].RawSize) + '") );';
661            Query.ExecSQL;
662            mimecoder.Free;
663          end
664          else
665          begin
666            Query.SQL.Text :=
667              'INSERT INTO rawmap (src_id,src_link_offset,sep,size) VALUES (' +
668              IntToStr(FileID) + ', ' + IntToStr(RawLinks[i].SrcOffset) + ', ' +
669              BoolToStr(RawLinks[i].LocSep) + ', 0);';
670            Query.ExecSQL;
671          end;
672        end;
673      end;
674
675      DatLinks := Connection.GetDatLinks(FileID);
676      if Length(DatLinks) > 0 then
677      begin
678        for i := 0 to High(DatLinks) do
679        begin
680          Query.SQL.Text :=
681            'INSERT INTO linkmap (src_id, src_link_offset, target_id) VALUES (' +
682            IntToStr(FileID) + ', ' + IntToStr(DatLinks[i].SrcOffset) + ', ' +
683            IntToStr(DatLinks[i].DestID) + ');';
684          Query.ExecSQL;
685        end;
686      end;
687    end
688    else
689    begin
690      Query.SQL.Text :=
691        'INSERT INTO datfiles (id,extension,name,contenttype,size) VALUES (' +
692        IntToStr(FileID) + ', "' + fileinfo.Extension + '", ' +
693        '"' + fileinfo.Name + '", "' + IntToHex(fileinfo.FileType, 8) + '", 0);';
694      Query.ExecSQL;
695    end;
696    if ((FileID mod 100) = 0) and (FileID > 0) then
697    begin
698      Database.Commit(False);
699      Database.StartTransaction;
700    end;
701    if ((FileID mod 10) = 0) and (FileID >= 100) then
702      lbl_estimation.Caption := 'Estimated time left: ' + TimeToStr(
703        (Time - FileTime) / FileID * (progress.Max - FileID + 1) * 1.1, timeformat );
704    progress.Position := FileID;
705    lbl_progress.Caption := 'Files done: ' + IntToStr(FileID) + '/' + IntToStr(progress.Max);
706    Application.ProcessMessages;
707    if abort then
708    begin
709      StopConvert;
710      Exit;
711    end;
712  end;
713  Database.Commit(False);
714  progress.Position      := progress.Max;
715  lbl_progress.Caption   := 'Files done: ' + IntToStr(progress.Max) + '/' +
716    IntToStr(progress.Max);
717
718  lbl_estimation.Caption := 'FINISHED (duration: ' + TimeToStr(Time - BeginTime, timeformat) + ')';
719
720  DoStep('FIN');
721  btn_abortok.Caption := '&OK';
722  btn_abortok.Default := True;
723
724  converting := False;
725
726  Query.Close;
727  Query.Free;
728  DataBase.Close;
729  DataBase.Free;
730end;
731
732
733
734
735procedure TForm_LevelDB.btn_abortokClick(Sender: TObject);
736begin
737  if converting then
738  begin
739    if MessageBox(Self.Handle,
740      PChar('Do you really want to cancel the convert-progress?'),
741      PChar('Warning: Converting'), MB_YESNO) = idYes then
742      abort := True;
743  end
744  else
745  begin
746    Self.Visible := False;
747    Form_Main.Visible  := True;
748  end;
749end;
750
751
752end.
Note: See TracBrowser for help on using the repository browser.