unit1.pas

罗小平<<delphi精要>>一书源码

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls;

type       
  TFileInfo = packed record
     FileName: String[255];
     FileSize: Integer;
     FileData: TMemoryStream;
  end;
  TFilesInfo = Array of TFileInfo;

  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    Button3: TButton;
    Button4: TButton;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure Button4Click(Sender: TObject);
  private
    Path: String;
    procedure FilesInfoToStream(FilesInfo: TFilesInfo; Stream: TStream);
    function StreamToFilesInfo(Stream: TStream): TFilesInfo;
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

uses ActiveX, AxCtrls;

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
var
  I: Integer;
  FilesInfo: TFilesInfo;
  SaveStream: TMemoryStream;
begin
  SetLength(FilesInfo, 3);
  for I := Low(FilesInfo) to High(FilesInfo) do
  with FilesInfo[I] do
  begin
    case I of
      0: FileName := '乖小孩.gif';
      1: FileName := '浴血长沙 ——第三次长沙会战守城记.htm';
      2: FileName := '双胞胎.jpg';
    end;
    FileData := TMemoryStream.Create;
    FileData.LoadFromFile(Path+FileName);
    FileSize := FileData.Size;
  end;

  SaveStream := TMemoryStream.Create;
  FilesInfoToStream(FilesInfo, SaveStream);
  SaveStream.SaveToFile(Path+'lxpbuaa.data');

  for I := Low(FilesInfo) to High(FilesInfo) do
    FilesInfo[I].FileData.Free;
  SaveStream.Free;
end;

procedure TForm1.FilesInfoToStream(FilesInfo: TFilesInfo; Stream: TStream);
var
  I: Integer;
begin
  I := Length(FilesInfo);
  Stream.Write(I, 4);
  for I := Low(FilesInfo) to High(FilesInfo) do
  with FilesInfo[I],Stream do
  begin
    Write(FileName[1], Sizeof(FileName)-1);
    Write(FileSize, SizeOf(FileSize));
    CopyFrom(FileData, FileData.Size);
  end;
  Stream.Position := 0;
end;

procedure TForm1.Button2Click(Sender: TObject);
var
  I: Integer;
  FilesInfo: TFilesInfo;
  LoadStream: TMemoryStream;
begin
  LoadStream := TMemoryStream.Create;
  LoadStream.LoadFromFile(Path+'lxpbuaa.data');
  FilesInfo := StreamToFilesInfo(LoadStream);
  LoadStream.Free;
  
  for I := Low(FilesInfo) to High(FilesInfo) do
  with FilesInfo[I] do
  begin
    FileData.SaveToFile(Path + 'Copy_' + Trim(FileName));
    FileData.Free;
  end;
end;

function TForm1.StreamToFilesInfo(Stream: TStream): TFilesInfo;
var
  I: Integer;
  Buffer: String[255];
begin
  Stream.Position := 0;
  Stream.Read(I, 4);
  SetLength(Result, I);
  for I := Low(Result) to High(Result) do
  with Result[I],Stream do
  begin
    Read(Buffer[1], SizeOf(Buffer)-1);
    FileName := Buffer;
    Read(FileSize, 4);
    FileData := TMemoryStream.Create;
    FileData.CopyFrom(Stream, FileSize);
    Seek(soFromCurrent, FileSize);
  end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  Path := ExtractFilePath(ParamStr(0));
end;

procedure TForm1.Button3Click(Sender: TObject);
var
  I,Mode: Integer;
  stgRoot: IStorage;
  stmName: String;
  stmData: IStream;
  OleStream: TOleStream;
  LoadStream: TMemoryStream;
begin
  Mode := STGM_CREATE+STGM_READWRITE+STGM_SHARE_EXCLUSIVE;
  StgCreateDocfile(StringToOleStr(Path + 'lxpbuaa.ss'),
    Mode, 0, stgRoot);

  LoadStream := TMemoryStream.Create;
  for I := 0 to 2 do
  begin
    case I of
      0: stmName := '乖小孩.gif';
      1: stmName := '浴血长沙 ——第三次长沙会战守城记.htm';
      2: stmName := '双胞胎.jpg';
    end;
    stgRoot.CreateStream(StringToOleStr(stmName), Mode, 0, 0, stmData);
    OleStream := TOleStream.Create(stmData);
    LoadStream.LoadFromFile(Path + stmName);
    LoadStream.Position := 0;
    OleStream.CopyFrom(LoadStream, LoadStream.Size);
    OleStream.Free;
  end;
  LoadStream.Free;
end;

procedure TForm1.Button4Click(Sender: TObject);
var
  Mode: Integer;
  stgRoot: IStorage;
  stmName: PWideChar;
  stmData: IStream;
  OleStream: TOleStream;
  LoadStream: TMemoryStream;
  EnumStatStg: IEnumStatStg;
  StatStg: TStatStg;
begin
  Mode := STGM_READ+STGM_SHARE_EXCLUSIVE;
  StgOpenStorage(StringToOleStr(Path + 'lxpbuaa.ss'),
    nil, Mode, nil, 0, stgRoot);
  LoadStream := TMemoryStream.Create;

   stgRoot.EnumElements(0, nil, 0, EnumStatStg);
   while EnumStatStg.Next(1, StatStg, nil) = S_OK do
   begin
     stmName := StatStg.pwcsName;
     stgRoot.OpenStream(stmName, nil, Mode, 0, stmData);
     OleStream := TOleStream.Create(stmData);
     LoadStream.Size := 0;
     LoadStream.CopyFrom(OleStream, OleStream.Size);
     LoadStream.SaveToFile(Path + 'Ss' + stmName);
     OleStream.Free;
   end;
   LoadStream.Free;
end;

end.