unit Access_OUP_ADB; interface uses DataAccess; type TAccess_OUP_ADB = class(TDataAccess) private { FDatabase: TABSDatabase; FQuery: TABSQuery; Fdat_files: TFiles; Fdat_extensionsmap: TExtensionsMap; protected public constructor Create(OLDBFilename: String; var Result: Boolean); override; procedure Close; override; procedure UpdateListCache; // function GetDatLinks(srcid:LongWord):TDatLinks; function GetFileInfo(fileid: Integer): TFileInfo; override; function GetFilesList(ext: String; pattern: String; NoEmptyFiles: Boolean; sort: TSortType): TStringArray; override; function GetFilesCount: LongWord; override; function GetExtensionsList: TStringArray; override; function GetExtendedExtensionsList: TExtensionsMap; override; function GetNamedFilesMap: TNamedFilesMap; 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; implementation (* ================================================================================ Implementation of TOniDataADB *) { constructor TOniDataADB.Create(OLDBFilename: String; var Result: Boolean); var i, j: Byte; temps: String; begin if not FileExists(OLDBFilename) then begin ShowMessage('File doesn''t exist!!!'); Result := False; Exit; end; FFileName := OLDBFilename; FDatabase := TABSDatabase.Create(nil); FDatabase.DatabaseName := 'OLDBcon'; FDatabase.DatabaseFileName := OLDBFilename; FDatabase.Open; FQuery := TABSQuery.Create(FDatabase); FQuery.DatabaseName := 'OLDBcon'; FQuery.SQL.Text := 'SELECT [name],[value] FROM globals ORDER BY [name] ASC'; FQuery.Open; FQuery.First; repeat if FQuery.FieldByName('name').AsString = 'dbversion' then begin if FQuery.FieldByName('value').AsString <> DBversion 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; UpdateListCache; Result := True; FBackend := ODB_ADB; end; procedure TOniDataADB.Close; begin FDatabase.Close; FDatabase.Free; Self.Free; end; procedure TOniDataADB.UpdateListCache; var i: LongWord; temps: String; begin FQuery.SQL.Text := 'SELECT id,name,extension,[size],contenttype FROM datfiles ORDER BY id ASC;'; FQuery.Open; if FQuery.RecordCount > 0 then begin FQuery.First; SetLength(Fdat_files, FQuery.RecordCount); i := 0; repeat Fdat_files[i].ID := FQuery.FieldByName('id').AsInteger; Fdat_files[i].Name := FQuery.FieldByName('name').AsString; Fdat_files[i].Extension := FQuery.FieldByName('extension').AsString; Fdat_files[i].FileName := FormatNumber(Fdat_files[i].ID, 5, '0') + '-' + Fdat_files[i].Name + '.' + Fdat_files[0].Extension; Fdat_files[i].FileNameHex := IntToHex(Fdat_files[i].ID, 4) + '-' + Fdat_files[i].Name + '.' + Fdat_files[0].Extension; Fdat_files[i].Size := FQuery.FieldByName('size').AsInteger; Fdat_files[i].FileType := HexToLong(FQuery.FieldByName('contenttype').AsString); Fdat_files[i].DatAddr := 0; Fdat_files[i].opened := False; Inc(i); FQuery.Next; until FQuery.EOF; end; FQuery.Close; SetLength(Fdat_extensionsmap, 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(Fdat_extensionsmap, FQuery.RecordCount); i := 0; repeat temps := FQuery.FieldByName('extension').AsString[1]; Fdat_extensionsmap[i].Extension[3] := temps[1]; Fdat_extensionsmap[i].Extension[2] := temps[2]; Fdat_extensionsmap[i].Extension[1] := temps[3]; Fdat_extensionsmap[i].Extension[0] := temps[4]; Fdat_extensionsmap[i].ExtCount := FQuery.FieldByName('x').AsInteger; Inc(i); FQuery.Next; until FQuery.EOF; end; FQuery.Close; end; function TOniDataADB.GetFileInfo(fileid: Integer): TFileInfo; var i: Integer; begin if fileid = -1 then begin Result := inherited GetFileInfo(fileid); Exit; end; if fileid < Self.GetFilesCount then begin for i := 0 to High(Fdat_files) do if Fdat_files[i].ID = fileid then Break; if i < Length(Fdat_files) then Result := Fdat_files[i] else Result.ID := -1; end else begin Result.ID := -1; end; end; function TOniDataADB.GetFilesList(ext: String; pattern: String; NoEmptyFiles: Boolean; sort: TSortType): TStringArray; var i: LongWord; list: TStringList; id, name, extension: String; fields: TStrings; procedure getfields; begin fields.CommaText := StringReplace(AnsiQuotedStr(list.Strings[i], '"'), ';', '","', [rfReplaceAll]); if sort in [stIDAsc, stIDDesc] then begin id := fields.Strings[0]; name := fields.Strings[1]; extension := fields.Strings[2]; end; if sort in [stNameAsc, stNameDesc] then begin id := fields.Strings[1]; name := fields.Strings[0]; extension := fields.Strings[2]; end; if sort in [stExtAsc, stExtDesc] then begin id := fields.Strings[1]; name := fields.Strings[2]; extension := fields.Strings[0]; end; end; begin list := TStringList.Create; list.Sorted := True; for i := 0 to High(Fdat_files) do begin if ((Length(ext) = 0) or (Pos(Fdat_files[i].Extension, ext) > 0)) 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 if AppSettings.FilenumbersAsHex then id := IntToHex(Fdat_files[i].ID, 4) else id := FormatNumber(Fdat_files[i].ID, 5, '0'); name := Fdat_files[i].Name; extension := Fdat_files[i].Extension; case sort of stIDAsc, stIDDesc: list.Add(id + ';' + name + ';' + extension); stNameAsc, stNameDesc: list.Add(name + ';' + id + ';' + extension); stExtAsc, stExtDesc: list.Add(extension + ';' + id + ';' + name); end; end; end; end; SetLength(Result, list.Count); fields := TStringList.Create; if sort in [stIDAsc, stNameAsc, stExtAsc] then for i := 0 to list.Count - 1 do begin getfields; Result[i] := id + '-' + name + '.' + extension; end else for i := list.Count - 1 downto 0 do begin getfields; Result[list.Count - i - 1] := id + '-' + name + '.' + extension; end; list.Free; fields.Free; end; function TOniDataADB.GetFilesCount: LongWord; begin Result := Length(Fdat_files); end; function TOniDataADB.GetExtensionsList: TStringArray; var i: LongWord; begin SetLength(Result, Length(Fdat_extensionsmap)); for i := 0 to High(Result) do begin with Fdat_extensionsmap[i] do begin Result[i] := Extension[3] + Extension[2] + Extension[1] + Extension[0] + ' (' + IntToStr(ExtCount) + ')'; end; end; end; function TOniDataADB.GetExtendedExtensionsList: TExtensionsMap; var i, j: LongWord; temps: String; Data: Tdata; begin SetLength(Result, 0); FQuery.SQL.Text := 'SELECT ext,ident FROM extlist ORDER BY ext ASC;'; FQuery.Open; if FQuery.RecordCount > 0 then begin SetLength(Result, FQuery.RecordCount); i := 0; repeat temps := FQuery.FieldByName('ext').AsString; for j := 0 to 3 do Result[i].Extension[j] := temps[4 - j]; Data := DecodeHexString(FQuery.FieldByName('ident').AsString); for j := 0 to 7 do Result[i].Ident[j] := Data[j]; Inc(i); FQuery.Next; until FQuery.EOF; end; FQuery.Close; end; function TOniDataADB.GetNamedFilesMap: TNamedFilesMap; var i: LongWord; temp: Integer; temps: String; temparray: array of record id: Integer; fullname: String[50]; end; begin SetLength(temparray, 0); FQuery.SQL.Text := 'SELECT id,(extension+name) AS xname FROM datfiles WHERE Length(name)>0 ORDER BY extension,name ASC;'; FQuery.Open; if FQuery.RecordCount > 0 then begin repeat temp := FQuery.FieldByName('id').AsInteger; temps := FQuery.FieldByName('xname').AsString; SetLength(temparray, Length(temparray) + 1); if Length(temparray) > 1 then begin for i := High(temparray) - 1 downto 0 do begin if StringSmaller(temps, temparray[i].fullname) then begin temparray[i + 1] := temparray[i]; if i = 0 then begin temparray[i].id := temp; temparray[i].fullname := temps; end; end else begin temparray[i + 1].id := temp; temparray[i + 1].fullname := temps; Break; end; end; end else begin temparray[0].id := temp; temparray[0].fullname := temps; end; FQuery.Next; until FQuery.EOF; end; FQuery.Close; SetLength(Result, Length(temparray)); for i := 0 to High(temparray) do begin Result[i].FileNumber := temparray[i].id; Result[i].blubb := 0; end; end; function TOniDataADB.LoadDatFile(fileid: LongWord): Tdata; var mem: TStream; begin if fileid < Self.GetFilesCount then begin FQuery.SQL.Text := 'SELECT data FROM datfiles WHERE id=' + IntToStr(fileid) + ';'; FQuery.Open; if FQuery.RecordCount > 0 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 fileid < Self.GetFilesCount then begin mimecoder := TStringFormat_MIME64.Create; mem := TMemoryStream.Create; mem.Write(Data[0], Length(Data)); mem.Seek(0, soFromBeginning); FQuery.SQL.Text := 'UPDATE datfiles SET data=MimeToBin("' + MimeCoder.StrTo(mem.Memory, mem.Size) + '"), size=' + IntToStr(mem.Size) + ' WHERE id=' + IntToStr(fileid) + ';'; FQuery.ExecSQL; mem.Free; mimecoder.Free; end; UpdateListCache; end; procedure TOniDataADB.LoadDatFilePart(fileid, offset, size: LongWord; target: Pointer); var mem: TStream; begin if fileid < Self.GetFilesCount then begin FQuery.SQL.Text := 'SELECT data FROM datfiles WHERE id=' + IntToStr(fileid) + ';'; FQuery.Open; if FQuery.RecordCount > 0 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 fileid < Self.GetFilesCount then begin Data := Self.LoadDatFile(fileid); mimecoder := TStringFormat_MIME64.Create; mem := TMemoryStream.Create; mem.Write(Data[0], Length(Data)); mem.Seek(offset, soFromBeginning); mem.Write(target^, size); mem.Seek(0, soFromBeginning); FQuery.SQL.Text := 'UPDATE datfiles SET data=MimeToBin("' + MimeCoder.StrTo(mem.Memory, mem.Size) + '") WHERE id=' + IntToStr(fileid) + ';'; FQuery.ExecSQL; mem.Free; mimecoder.Free; end; end; function TOniDataADB.GetRawList(fileid: LongWord): TRawList; var i: LongWord; begin SetLength(Result, 0); FQuery.SQL.Text := 'SELECT [src_link_offset],[size],[sep] FROM rawmap WHERE [src_id]=' + IntToStr(fileid) + ' ORDER BY src_link_offset ASC;'; FQuery.Open; if FQuery.RecordCount > 0 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; Result[i].loc_sep := FQuery.FieldByName('sep').AsBoolean; 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 fileid < Self.GetFilesCount then begin FQuery.SQL.Text := 'SELECT data FROM rawmap WHERE (src_id=' + IntToStr(fileid) + ') AND (src_link_offset=' + IntToStr(dat_offset) + ');'; FQuery.Open; if FQuery.RecordCount > 0 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 < Self.GetFilesCount then begin mimecoder := TStringFormat_MIME64.Create; mem := TMemoryStream.Create; mem.Write(target^, size); mem.Seek(0, soFromBeginning); FQuery.SQL.Text := 'UPDATE rawmap SET data=MimeToBin("' + MimeCoder.StrTo( mem.Memory, mem.Size) + '") WHERE (src_id=' + IntToStr(fileid) + ') AND (src_link_offset=' + IntToStr(dat_offset) + ');'; FQuery.ExecSQL; mem.Free; mimecoder.Free; end; end; procedure TOniDataADB.LoadRawFilePart(fileid, dat_offset: LongWord; offset, size: LongWord; target: Pointer); var Data: Tdata; mem: TMemoryStream; begin if fileid < Self.GetFilesCount then begin SetLength(Data, Self.GetRawInfo(fileid, dat_offset).raw_size); Self.LoadRawFile(fileid, dat_offset, @Data[0]); mem := TMemoryStream.Create; mem.Write(Data[offset], size); mem.Read(target^, size); mem.Free; end; end; procedure TOniDataADB.UpdateRawFilePart(fileid, dat_offset: LongWord; offset, size: LongWord; target: Pointer); var MimeCoder: TStringFormat_MIME64; mem: TMemoryStream; Data: Tdata; begin if fileid < Self.GetFilesCount then begin SetLength(Data, Self.GetRawInfo(fileid, offset).raw_size); Self.LoadRawFile(fileid, offset, @Data[0]); mimecoder := TStringFormat_MIME64.Create; mem := TMemoryStream.Create; mem.Write(Data[0], Length(Data)); mem.Seek(offset, soFromBeginning); mem.Write(target^, size); mem.Seek(0, soFromBeginning); FQuery.SQL.Text := 'UPDATE rawmap SET data=MimeToBin("' + MimeCoder.StrTo( mem.Memory, mem.Size) + '") WHERE (src_id=' + IntToStr(fileid) + ') AND (src_link_offset=' + IntToStr(dat_offset) + ');'; FQuery.ExecSQL; mem.Free; mimecoder.Free; end; end; } end.