Delphi怎样往dat文件中存取数据？

Question

如题，请给出主要的代码，分数没多少了，但谢谢大家帮忙。

Answer 1

var
  aStream: TFileStream;
begin
  aStream:= TFileStream.Create('a.dat', fmOpenReadWrite);
  try
    aStream.Write(buffer);
  finally
    FreeAndNil(aStream);
  end;
end;

Answer 2

楼上的这种方式，如果dat数据量非常大，例如，把10张50M大的图片存入，那么，从中取出第七张，恐惊没几秒都不能把整张第7张读出来。

Answer 3

你说的跟ZIP压缩一样。。把好多文件写入一个文件
给你个思路吧。
unit KanaPK;interfaceUses
 Windows,Messages,SysUtils,Classes,Zlib;Const
 Header = $4B504B; //KanaType
 TFileCompressionLevel = (fcNone, fcFastest, fcDefault, fcMax); //压缩级别
 TProgressEvent = procedure(Percentage : Integer) of object; //正在处理的百分比事件通知
 TOpenArchiveFileEvent = procedure(FileName : String; FileCount : Integer) of object; //当打开压缩包时的事件通知
 TErrorEvent = procedure(ErrorText : String) of object; //出错事件通知
 TMessageEvent = procedure(MessageText : String) of object; //信息事件通知Type  //压缩包文件信息
 TKPKRec = record
  Header  : Longint;
  Comment : String[25];
 end;Type  //源文件信息
 TFileRec = record
  Name : ShortString; //源文件名，不包括驱动器名称
  Size : LongInt;     //源文件的原始大小
  PackedSize : LongInt;  //源文件压缩后大小
  Modified : TDateTime;  //源文件修改时间
  Ratio : String[4]; //压缩百分比
  SPosition : LongInt;  //源文件在压缩包的位置（流）
  end;Type
  TKanaPK = class(TComponent) //继承自TComponent类
  private
   FActive   : Boolean;
   FArchive  : String; //包文件名称
   FFileList : TList;  //压缩包里文件的列表
   FCompressionLevel : TFileCompressionLevel;//压缩级别   FOnProgress : TProgressEvent;
   FOnOpenArchive : TOpenArchiveFileEvent;
   FOnError : TErrorEvent;
   FAddProgressTotal : LongInt;
   FAddProgressText : String;
   FOnMessage : TMessageEvent;   function  GetTempFileN : String;
   function  GetFileTime(FileName : String) : TDateTime;
   function  HeaderIsValid : Boolean;
   function  GetFileInfo(Index : Integer) : TFileRec;
   function  GetFileInPK(FileName : String) : Integer;
   procedure InitFileList;
   procedure DoAddProgress(Sender:TObject);
  public
   constructor Create(AOwner: TComponent); override;
   destructor  Destroy; override;
   function    Open : Boolean;
   procedure   Close;
   function    CreateNew(FileName : String; Comment : String) : Boolean;
   property    Files[index :Integer]: TFileRec read GetFileInfo;
   function    GetPKFileCount : Integer;
   procedure   AddFiles(FileList : TStrings);
   procedure   ExtractToFile(FileName : String; SaveName : String);
   procedure   ExtractAll(SavePath : String);
   procedure   RenameFileByName(OldFileName : String; NewFileName : String);
   procedure   DeleteFiles(FileList : TStrings);
   procedure   UpdateFileByName(InPkFileName : String; UpdateFileName : String);
  published
   property ArchiveFileName : String read FArchive write FArchive;
   property CompressionLevel :TFileCompressionLevel read FCompressionLevel write FCompressionLevel default fcDefault;
   property OnProgress : TProgressEvent read FOnProgress write FOnProgress;
   property OnOpenArchive : TOpenArchiveFileEvent read FOnOpenArchive write FOnOpenArchive;
   property OnError : TErrorEvent read FOnError write FOnError;
   property OnMessage : TMessageEvent read FOnMessage write FOnMessage;
  end;procedure Register;function FileTimeToStr(Format : String; FileTime : TDateTime) : String;implementation// -------------------------------------------------------
// Name: Register()
// Describe: 注册控件
// -------------------------------------------------------
procedure Register;
begin
  RegisterComponents('KanaPK',[TKanaPK]);
end;// -------------------------------------------------------
// Name: FileTimeToStr()
// Describe: 把TDateTime转换为字符串
// -------------------------------------------------------
function FileTimeToStr(Format : String; FileTime : TDateTime) : String;
begin
  if Format ='' then
   begin
    Result := FormatDateTime('yy/mm/dd hh:mm:ss',FileTime);
   end
   else
   begin
    Result := FormatDateTime(Format,FileTime);
   end;
end;// -------------------------------------------------------
// Name: ExtractFileNameWithoutDri()
// Describe: 返回指定文件不包括驱动器名称的字符串
// -------------------------------------------------------
function ExtractFileNameWithoutDri(FileName : String) : String;
begin
 Result := FileName;
 Delete(Result,1,pos(':',Result));
end;{ TKanaPK }
// -------------------------------------------------------
// Name: Create()
// Describe: 建立对象
// -------------------------------------------------------
constructor TKanaPK.Create(AOwner: TComponent);
begin
  inherited;
  FActive := False;
  FFileList := TList.Create;  //初始化FFileList
  FCompressionLevel := fcdefault;
end;// -------------------------------------------------------
// Name: Destroy()
// Describe: 卸载对象
// -------------------------------------------------------
destructor TKanaPK.Destroy;
begin
  inherited;
  Close;
  FFileList.Free; //卸载FFileList
end;// -------------------------------------------------------
// Name: GetTempFileN()
// Describe: 创建临时文件，并得到文件名
// -------------------------------------------------------
function TKanaPK.GetTempFileN : String;
var
   _TempPath : string;
   _TempFile : string;
begin
     SetLength(_TempPath, Max_Path);
     setlength(_TempFile, Max_Path);
     GetTempPath(Max_Path, pchar(_TempPath)); //得到临时文件目录
     GetTempFilename(Pchar(_TempPath),'KanaPK',0,Pchar(_TempFile));
     Result := _TempFile;
end;// -------------------------------------------------------
// Name: GetFileTime()
// Describe: 得到文件的时间
// -------------------------------------------------------
function TKanaPK.GetFileTime(FileName : String) : TDateTime;
Var
 _FileHandle : THandle;
 _FTime : TDateTime;
 _FindData : TWin32FindData;
 _SysTime:_SystemTime;
 _FTempTime:_FileTime;
begin
  _FileHandle := FindFirstFile(Pchar(FileName), _FindData);
  Windows.FindClose(_FileHandle);
  FileTimeToLocalFileTime(_FindData.ftLastWriteTime,_FTempTime);  //ftLastWriteTime 文件修改时间
  FileTimeToSystemTime(_FTempTime,_SysTime);
  _FTime := SystemTimeToDateTime(_SysTime);
  Result := _FTime;
end;// -------------------------------------------------------
// Name: HeaderIsValid()
// Describe: 判断一个文件是否是我们自己的压缩包文件
// -------------------------------------------------------
function TKanaPK.HeaderIsValid : Boolean;
Var
 _TempStream : TFileStream;
 _KPKRec : TKPKRec;
begin
  Result := False;
  if FileExists(FArchive) then
   begin
    _TempStream := TFileStream.Create(FArchive,FmOpenReadWrite);
    _TempStream.Read(_KPKRec,SizeOf(TKPKRec));
    if Header = _KPKRec.Header then //判断是否是$4B504B
     begin
      Result := True;
     end;
    _TempStream.Free;
   end;
end;// -------------------------------------------------------
// Name: Open()
// Describe: 打开当前文件
// -------------------------------------------------------
function TKanaPK.Open : Boolean;
begin
  Result := False;
  if HeaderIsValid then
   begin
    Close;
    FActive := True;
    InitFileList;  //初始化文件列表
    Result := True;
    if Assigned(FOnOpenArchive) then OnOpenArchive(FArchive,FFileList.Count);
   end
   else
   begin //错误通知
    if Assigned(FOnError) then FOnError(FArchive +' 文件不是有效的KPK压缩文件');
   end;
end;// -------------------------------------------------------
// Name: Close()
// Describe: 关闭当前文件
// -------------------------------------------------------
procedure TKanaPK.Close;
var
 I : Integer;
 _FileInfo : Pointer;
begin
  if FActive = True then
   begin
    FActive := False;
    for i := FFileList.Count -1 downto 0 do
     begin
      _FileInfo := FFileList.Items[I];
      FFileList.Delete(I);
      FreeMem(_FileInfo,SizeOf(TFileRec));
     end;
    FFileList.Clear;
   end;
end;

Answer 4

// -------------------------------------------------------
// Name: CreateNew()
// Describe: 创建新的压缩包文件
// -------------------------------------------------------
function TKanaPK.CreateNew(FileName : String; Comment : String) : Boolean;
Var
 _NewPKFile : TFileStream;
 _KPKRec : TKPKRec;
begin
  Result := True;
  _NewPKFile := TFileStream.Create(FileName,FmCreate);
  _KPKRec.Header := Header;
  _KPKRec.Comment := Comment;
  if Comment ='' then _KPKRec.Comment := 'Create By Kana,Love CW';
  _NewPKFile.Write(_KPKRec,SizeOf(TKPKRec)); //写入压缩包文件信息
  _NewPKFile.Free;
  if Assigned(FOnMessage) then FOnMessage('Create Archive '+FileName);
end;// -------------------------------------------------------
// Name: GetFileInfo()
// Describe: 返回一个在压缩包里文件的信息
// -------------------------------------------------------
function TKanaPK.GetFileInfo(Index: Integer): TFileRec;
begin
  if (Index < FFileList.Count) and (Index >= 0) then
  Result := TFileRec(FFileList.items[index]^);
end;// -------------------------------------------------------
// Name: GetPKFileCount()
// Describe: 返回一共有多少个文件在压缩包里
// -------------------------------------------------------
function TKanaPK.GetPKFileCount: Integer;
begin
  Result := 0;
  if FActive = True then
   begin
    Result := FFileList.Count ;
   end;
end;// -------------------------------------------------------
// Name: InitFileList()
// Describe: 根据压缩包文件，创建文件信息列表
// -------------------------------------------------------
procedure TKanaPK.InitFileList;
var
  _TempStream : TFileStream;
  _FileRec : TFileRec;
  _FileInfo : Pointer;
begin
  if FActive = True then
   begin
    _TempStream := TFileStream.Create(FArchive,FmOpenReadWrite);
    _TempStream.Seek(SizeOF(TKPKRec),soBeginning); //首先跳过压缩包文件信息
    while True do
     begin  //循环
      if _TempStream.Position = _TempStream.Size then Break;      _TempStream.Read(_FileRec,SizeOF(TFileRec)); //得到一个源文件信息
      _TempStream.Seek(_FileRec.PackedSize,soCurrent);  //跳过源文件压缩后的字节数      Getmem(_FileInfo,SizeOf(TFileRec));
      CopyMemory(_FileInfo,@_FileRec,SizeOf(TFileRec));
      FFileList.Add(_FileInfo);  //加入文件列表
     end;
    _TempStream.Free;
   end;
end;// -------------------------------------------------------
// Name: GetFileInPK()
// Describe: 根据文件名，返回文件在列表中的位置
// -------------------------------------------------------
function TKanaPK.GetFileInPK(FileName : String) : Integer;
var
 I : Integer;
begin
  Result := -1;
  for I := FFileList.Count -1 Downto 0 do
   begin
    if LowerCase(FileName) = LowerCase(TFileRec(FFileList.items[I]^).Name) then
     begin
      Result := I;
      Break;
     end;
   end;
end;// -------------------------------------------------------
// Name: DoAddProgress()
// Describe: 添加一个文件到压缩包的事件通知
// -------------------------------------------------------
procedure TKanaPK.DoAddProgress(Sender: TObject);
begin
  if Assigned(FOnMessage) then FOnMessage(FAddProgressText);
  if Assigned(FOnProgress) then FOnProgress(Round((TCustomZLibStream(Sender).Position / FAddProgressTotal)*100));
end;

Answer 5

// -------------------------------------------------------
// Name: AddFiles()
// Describe: 添加一些文件到压缩包
// -------------------------------------------------------
procedure TKanaPK.AddFiles(FileList : TStrings);
var
 _CompStream : TCompressionStream;
 _TempFile : String; //临时文件名称
 _FileRec : TFileRec;
 _InFileS : TFileStream; //要添加的源文件流
 _TempStream : TFileStream; //临时文件流
 _ArchiveFS : TFileStream; //压缩包文件流
 I : Integer;
begin
  if FActive = True then
   begin
    for i := 0 to FileList.Count -1 do
     begin
      if GetFileInPK(ExtractFileNameWithoutDri(FileList[I])) <> -1 then
       begin  //判断要添加的文件是否已经在压缩包里
        FileList.Delete(I);
        if Assigned(FOnError) then FOnError(FileList[I]+ ' Already Exists In The Archive');
       end;
     end;
    if FileList.Count = 0  then Exit; //判断是文件列表里是否还有要添加的文件
    for i := 0 to FileList.Count -1 do
     begin //循环添加文件
      if FileExists(FileList[I]) = True then
       begin
        _InFileS := TFileStream.Create(FileList[I],FmOpenRead + FmShareDenyWrite);
        _FileRec.Name := ExtractFileNameWithoutDri(FileList[I]);
        _FileRec.Size := _InFileS.Size;
        _FileRec.Modified := GetFileTime(FileList[I]);        _TempFile := GetTempFileN;
        _TempStream := TFileStream.Create(_TempFile,FmCreate);
        _CompStream := TCompressionStream.Create(TCompressionLevel(FCompressionLevel), _TempStream);
        FAddProgressTotal := _InFileS.Size;
        FAddProgressText := 'Add File To Archive: ' + FileList[I];
        _CompStream.OnProgress := DoAddProgress;
        _CompStream.CopyFrom(_InFileS,0);        _FileRec.Ratio := IntToStr(Round(_CompStream.CompressionRate))+'%';
        _CompStream.Free;        _FileRec.PackedSize := _TempStream.Size;        _ArchiveFS := TFileStream.Create(FArchive,FmOpenReadWrite);
        _ArchiveFS.Seek(0,SoEnd);        _FileRec.SPosition := _ArchiveFS.Position;        _ArchiveFS.Write(_FileRec,SizeOf(TFileRec));
        _ArchiveFS.CopyFrom(_TempStream,0);        _InFileS.Free;
        _TempStream.Free;
        _ArchiveFS.Free;
        DeleteFile(_TempFile);
        if Assigned(FOnMessage) then FOnMessage('');
        if Assigned(FOnProgress) then FOnProgress(0);
       end
       else
       begin
        if Assigned(FOnError) then FOnError(FileList[I]+ ' File Not Found');
       end;
     end;
    Open;
   end;
end;// -------------------------------------------------------
// Name: ExtractToFile()
// Describe: 释放一个在压缩包里的文件到指定位置
// -------------------------------------------------------
procedure TKanaPK.ExtractToFile(FileName : String; SaveName : String);
var
 _Index : Integer;
 _Buffer : Pointer;
 _Count : Int64;
 _Size : Integer;
 _bufferSize : Integer;
 _ProgressIndex : LongInt;
 _ProgressTotal : LongInt;
 _DecompStream: TDecompressionStream;
 _OutFileS : TFileStream;
 _ArchiveFS : TFileStream;
begin
  if FActive = True then
   begin
    _Index := GetFileInPK(FileName); //要释放的文件是否在压缩包里
    if _Index <> -1 then //在压缩包里
     begin
      _OutFileS := TFileStream.Create(SaveName,FmCreate);
      _ArchiveFS := TFileStream.Create(FArchive,fmOpenReadWrite);
      _ArchiveFS.Seek(Files[_Index].SPosition + SizeOf(TFileRec),soBeginning);      _DecompStream := TDecompressionStream.Create(_ArchiveFS);      _Size := Files[_Index].Size;
      _ProgressTotal := Files[_Index].Size;
      _ProgressIndex := 0;
      while  True do
       begin
        if _Size <= 0 then Break;
        if _Size >= 4096 then _BufferSize := 4096 else _BufferSize := _Size;        Getmem(_Buffer,_BufferSize);
        _Count := _DecompStream.Read(_Buffer^, _BufferSize); //解压缩
        Inc(_ProgressIndex,_Count);        if Assigned(FOnMessage) then FOnMessage('Extract File: '+FileName);
        if Assigned(FOnProgress) then FOnProgress(Round((_ProgressIndex/_ProgressTotal)*100));        _OutFiles.WriteBuffer(_Buffer^, _Count);
        
        Dec(_Size,_BufferSize);
        Freemem(_Buffer,_BufferSize);
       end;      _DecompStream.Free;
      _OutFileS.Free;
      _ArchiveFS.Free;
      if Assigned(FOnMessage) then FOnMessage('');
      if Assigned(FOnProgress) then FOnProgress(0);
     end
     else
     begin
      if Assigned(FOnError) then FOnError('Extract File : ' +FileName+ ' Not In The Archive');
     end;
   end;
end;// -------------------------------------------------------
// Name: ExtractAll()
// Describe: 释放压缩包里的所有文件
// -------------------------------------------------------
procedure TKanaPK.ExtractAll(SavePath: String);
var
 I : Integer;
 _Buffer : Pointer;
 _Count : Int64;
 _Size : Integer;
 _bufferSize : Integer;
 _ProgressIndex : LongInt;
 _ProgressTotal : LongInt;
 _DecompStream: TDecompressionStream;
 _OutFileS : TFileStream;
 _ArchiveFS : TFileStream;
begin
  if FActive = True then
   begin
    if SavePath[Length(SavePath)] = '\' then SavePath := Copy(SavePath,0,Length(SavePath) -1);  
    For I := 0 to FFileList.Count -1 do
     begin      if  not DirectoryExists(SavePath + ExtractFilePath(Files[I].Name)) then
       begin  //判断目录是否存在，不存在则创建
        ForceDirectories(SavePath + ExtractFilePath(Files[I].Name));
       end;
       
      _OutFileS := TFileStream.Create(SavePath + Files[I].Name, FmCreate);
      _ArchiveFS := TFileStream.Create(FArchive,fmOpenReadWrite);
      _ArchiveFS.Seek(Files[I].SPosition + SizeOf(TFileRec),soBeginning);      _DecompStream := TDecompressionStream.Create(_ArchiveFS);      _Size := Files[I].Size;
      _ProgressTotal := Files[I].Size;
      _ProgressIndex := 0;
      while  True do
       begin
        if _Size <= 0 then Break;
        if _Size >= 4096 then _BufferSize := 4096 else _BufferSize := _Size;        Getmem(_Buffer,_BufferSize);
        _Count := _DecompStream.Read(_Buffer^, _BufferSize);
        Inc(_ProgressIndex,_Count);        if Assigned(FOnMessage) then FOnMessage('Extract File: '+ Files[I].Name);
        if Assigned(FOnProgress) then FOnProgress(Round((_ProgressIndex/_ProgressTotal)*100));        _OutFiles.WriteBuffer(_Buffer^, _Count);
        
        Dec(_Size,_BufferSize);
        Freemem(_Buffer,_BufferSize);
       end;      _DecompStream.Free;
      _OutFileS.Free;
      _ArchiveFS.Free;
      if Assigned(FOnMessage) then FOnMessage('');
      if Assigned(FOnProgress) then FOnProgress(0);
     end;
   end;
end;