unit Access_OUP_ADB; interface uses DataAccess, ABSMain, TypeDefs, Classes; type TAccess_OUP_ADB = class(TDataAccess) private FDatabase: TABSDatabase; FQuery: TABSQuery; Fdat_files: TFiles; Fdat_extensionsmap: TExtensionsMap; protected public constructor Create(DBFilename: String; ConnectionID: Integer; var Msg: TStatusMessages); override; procedure Close; override; procedure UpdateListCache; function GetFileInfo(FileID: Integer): TFileInfo; override; function GetFilesList(Ext: String; Pattern: String; NoEmptyFiles: Boolean; SortType: TSortType): TStrings; override; function GetFileCount: Integer; override; function GetExtensionsList(ExtListFormat: TExtensionFormat): TStrings; override; procedure LoadDatFile(FileID: Integer; var Target: TStream); overload; override; procedure UpdateDatFile(FileID: Integer; Src: TStream); overload; override; procedure LoadDatFilePart(FileID, Offset, Size: Integer; var Target: TStream); overload; override; procedure UpdateDatFilePart(FileID, Offset, Size: Integer; Src: TStream); overload; override; function GetRawList(FileID: Integer): TRawDataList; override; function GetRawInfo(FileID, DatOffset: Integer): TRawDataInfo; override; procedure LoadRawFile(FileID, DatOffset: Integer; var Target: TStream); overload; override; procedure UpdateRawFile(FileID, DatOffset: Integer; Src: TStream); overload; override; procedure LoadRawFilePart(FileID, DatOffset, Offset, Size: Integer; var Target: TStream); overload; override; procedure UpdateRawFilePart(FileID, DatOffset, Offset, Size: Integer; Src: TStream); overload; override; published end; implementation uses SysUtils, Data, Functions, ABSDecUtil, DB; (* ================================================================================ Implementation of TOniDataADB *) constructor TAccess_OUP_ADB.Create(DBFilename: String; ConnectionID: Integer; var Msg: TStatusMessages); var i: Integer; begin Msg := SM_UnknownError; if not FileExists(DBFilename) then begin Msg := SM_FileNotFound; Exit; end; FFileName := DBFilename; FDatabase := TABSDatabase.Create(nil); FDatabase.DatabaseName := 'OLDBcon' + IntToStr(ConnectionID); FDatabase.DatabaseFileName := DBFilename; FDatabase.Open; FQuery := TABSQuery.Create(FDatabase); FQuery.DatabaseName := 'OLDBcon' + IntToStr(ConnectionID); 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 Msg := SM_IncompatibleDBVersion; FQuery.Close; Exit; end; end; if FQuery.FieldByName('name').AsString = 'lvl' then FLevelNumber := StrToInt(FQuery.FieldByName('value').AsString); if FQuery.FieldByName('name').AsString = 'DataOS' then begin if FQuery.FieldByName('value').AsString = 'WIN' then FDataOS := DOS_WIN else if FQuery.FieldByName('value').AsString = 'WINDEMO' then FDataOS := DOS_WINDEMO else if FQuery.FieldByName('value').AsString = 'MAC' then FDataOS := DOS_MAC else if FQuery.FieldByName('value').AsString = 'MACBETA' then FDataOS := DOS_MACBETA; end; FQuery.Next; until FQuery.EOF; FQuery.Close; Msg := SM_OK; FBackend := DB_ADB; FChangeRights := [CR_EditDat, CR_EditRaw, CR_ResizeDat, CR_ResizeRaw]; UpdateListCache; end; procedure TAccess_OUP_ADB.Close; begin FQuery.Free; FDatabase.Close; FDatabase.Free; Self.Free; end; procedure TAccess_OUP_ADB.UpdateListCache; var i: Integer; temps: String; begin FQuery.SQL.Text := 'SELECT id,name,extension,[size],contenttype FROM datfiles ORDER BY id ASC;'; FQuery.Open; SetLength(Fdat_files, FQuery.RecordCount); if FQuery.RecordCount > 0 then begin FQuery.First; 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].Size := FQuery.FieldByName('size').AsInteger; Fdat_files[i].FileType := HexToLong(FQuery.FieldByName('contenttype').AsString); Fdat_files[i].DatAddr := 0; Inc(i); FQuery.Next; until FQuery.EOF; end; FQuery.Close; FQuery.SQL.Text := 'SELECT extension,count(extension) AS x FROM datfiles GROUP BY extension ORDER BY extension ASC;'; FQuery.Open; SetLength(Fdat_extensionsmap, FQuery.RecordCount); if FQuery.RecordCount > 0 then begin i := 0; repeat temps := FQuery.FieldByName('extension').AsString; 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 TAccess_OUP_ADB.GetFileInfo(fileid: Integer): TFileInfo; begin if fileid = -1 then begin Result := inherited GetFileInfo(fileid); Exit; end; if fileid < Self.GetFileCount then Result := Fdat_files[fileid] else Result.ID := -1; end; function TAccess_OUP_ADB.GetFilesList(ext: String; pattern: String; NoEmptyFiles: Boolean; SortType: TSortType): TStrings; var i: Integer; list: TStringList; id, name, extension: String; fields: TStrings; procedure getfields; begin fields.CommaText := StringReplace(AnsiQuotedStr(list.Strings[i], '"'), ';', '","', [rfReplaceAll]); if SortType in [ST_IDAsc, ST_IDDesc] then begin id := fields.Strings[0]; name := fields.Strings[1]; extension := fields.Strings[2]; end; if SortType in [ST_NameAsc, ST_NameDesc] then begin id := fields.Strings[1]; name := fields.Strings[0]; extension := fields.Strings[2]; end; if SortType in [ST_ExtAsc, ST_ExtDesc] 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 GetFileCount - 1 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 SortType of ST_IDAsc, ST_IDDesc: list.Add(id + ';' + name + ';' + extension); ST_NameAsc, ST_NameDesc: list.Add(name + ';' + id + ';' + extension); ST_ExtAsc, ST_ExtDesc: list.Add(extension + ';' + id + ';' + name); end; end; end; end; Result := TStringList.Create; if list.Count > 0 then begin fields := TStringList.Create; if SortType in [ST_IDAsc, ST_NameAsc, ST_ExtAsc] then for i := 0 to list.Count - 1 do begin getfields; Result.Add(id + '-' + name + '.' + extension); end else for i := list.Count - 1 downto 0 do begin getfields; Result.Add(id + '-' + name + '.' + extension); end; fields.Free; end; list.Free; end; function TAccess_OUP_ADB.GetFileCount: Integer; begin Result := Length(Fdat_files); end; function TAccess_OUP_ADB.GetExtensionsList(ExtListFormat: TExtensionFormat): TStrings; var i: Integer; begin Result := TStringList.Create; for i := 0 to Length(Fdat_extensionsmap) - 1 do begin with Fdat_extensionsmap[i] do begin case ExtListFormat of EF_ExtOnly: Result.Add(Extension[3] + Extension[2] + Extension[1] + Extension[0]); EF_ExtCount: Result.Add(Extension[3] + Extension[2] + Extension[1] + Extension[0] + ' (' + IntToStr(ExtCount) + ')'); end; end; end; end; procedure TAccess_OUP_ADB.LoadDatFile(FileID: Integer; var Target: TStream); var mem: TStream; streampos: Integer; begin if fileid < GetFileCount then begin if not Assigned(Target) then Target := TMemoryStream.Create; streampos := Target.Position; 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(0, soFromBeginning); Target.CopyFrom(mem, mem.Size); mem.Free; end; FQuery.Close; Target.Seek(streampos, soFromBeginning); end; end; procedure TAccess_OUP_ADB.UpdateDatFile(FileID: Integer; Src: TStream); var MimeCoder: TStringFormat_MIME64; mem: TMemoryStream; begin if fileid < GetFileCount then begin mimecoder := TStringFormat_MIME64.Create; mem := TMemoryStream.Create; mem.CopyFrom(Src, Src.Size); 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; end; procedure TAccess_OUP_ADB.LoadDatFilePart(FileID, Offset, Size: Integer; var Target: TStream); var streampos: Integer; mem: TStream; begin if fileid < GetFileCount then begin if not Assigned(Target) then Target := TMemoryStream.Create; streampos := Target.Position; 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); Target.CopyFrom(mem, size); mem.Free; end; FQuery.Close; Target.Seek(streampos, soFromBeginning); end; end; procedure TAccess_OUP_ADB.UpdateDatFilePart(FileID, Offset, Size: Integer; Src: TStream); var MimeCoder: TStringFormat_MIME64; mem: TMemoryStream; begin if fileid < GetFileCount then begin mem := nil; LoadDatFile(fileid, TStream(mem)); mem.Seek(Offset, soFromBeginning); mem.CopyFrom(Src, Size); mem.Seek(0, soFromBeginning); mimecoder := TStringFormat_MIME64.Create; 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 TAccess_OUP_ADB.GetRawList(FileID: Integer): TRawDataList; var i: Integer; 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].SrcID := fileid; Result[i].SrcOffset := FQuery.FieldByName('src_link_offset').AsInteger; Result[i].RawAddr := 0; Result[i].RawSize := FQuery.FieldByName('size').AsInteger; Result[i].LocSep := FQuery.FieldByName('sep').AsBoolean; Inc(i); FQuery.Next; until FQuery.EOF; end; FQuery.Close; end; function TAccess_OUP_ADB.GetRawInfo(FileID, DatOffset: Integer): TRawDataInfo; var i: Integer; rawlist: TRawDataList; begin rawlist := GetRawList(FileID); if Length(rawlist) > 0 then begin for i := 0 to High(rawlist) do if rawlist[i].SrcOffset = DatOffset then Break; if i < Length(rawlist) then Result := rawlist[i] else begin Result.SrcID := -1; Result.SrcOffset := -1; Result.RawAddr := -1; Result.RawSize := -1; end; end; end; procedure TAccess_OUP_ADB.LoadRawFile(FileID, DatOffset: Integer; var Target: TStream); var mem: TStream; streampos: Integer; begin if fileid < GetFileCount then begin if not Assigned(Target) then Target := TMemoryStream.Create; streampos := Target.Position; FQuery.SQL.Text := 'SELECT data FROM rawmap WHERE (src_id=' + IntToStr(FileID) + ') AND (src_link_offset=' + IntToStr(DatOffset) + ');'; FQuery.Open; if FQuery.RecordCount > 0 then begin mem := FQuery.CreateBlobStream(FQuery.FieldByName('data'), bmRead); mem.Seek(0, soFromBeginning); Target.CopyFrom(mem, mem.Size); mem.Free; end; FQuery.Close; Target.Seek(streampos, soFromBeginning); end; end; procedure TAccess_OUP_ADB.UpdateRawFile(FileID, DatOffset: Integer; Src: TStream); var MimeCoder: TStringFormat_MIME64; mem: TMemoryStream; begin if fileid < GetFileCount then begin mimecoder := TStringFormat_MIME64.Create; mem := TMemoryStream.Create; mem.CopyFrom(Src, Src.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(DatOffset) + ');'; FQuery.ExecSQL; mem.Free; mimecoder.Free; end; end; procedure TAccess_OUP_ADB.LoadRawFilePart(FileID, DatOffset, Offset, Size: Integer; var Target: TStream); var mem: TMemoryStream; streampos: Integer; begin if fileid < GetFileCount then begin if not Assigned(Target) then Target := TMemoryStream.Create; streampos := Target.Position; mem := nil; LoadRawFile(FileID, DatOffset, TStream(mem)); mem.Seek(Offset, soFromBeginning); Target.CopyFrom(mem, Size); mem.Free; Target.Seek(streampos, soFromBeginning); end; end; procedure TAccess_OUP_ADB.UpdateRawFilePart(FileID, DatOffset, Offset, Size: Integer; Src: TStream); var MimeCoder: TStringFormat_MIME64; mem: TMemoryStream; begin if fileid < GetFileCount then begin mem := nil; LoadRawFile(fileid, offset, TStream(mem)); mem.Seek(offset, soFromBeginning); mem.CopyFrom(Src, Size); mem.Seek(0, soFromBeginning); mimecoder := TStringFormat_MIME64.Create; FQuery.SQL.Text := 'UPDATE rawmap SET data=MimeToBin("' + MimeCoder.StrTo( mem.Memory, mem.Size) + '") WHERE (src_id=' + IntToStr(fileid) + ') AND (src_link_offset=' + IntToStr(DatOffset) + ');'; FQuery.ExecSQL; mem.Free; mimecoder.Free; end; end; end.