复杂的结构化存取(二)

本例效果图:

---

代码文件:

---

unit Unit1;



interface



uses

  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

  Dialogs, StdCtrls;



type

  TForm1 = class(TForm)

    Button1: TButton;

    Button2: TButton;

    procedure FormCreate(Sender: TObject);

    procedure Button1Click(Sender: TObject);

    procedure Button2Click(Sender: TObject);

  end;



var

  Form1: TForm1;



implementation



{$R *.dfm}



Uses Activex;



type

  TRec = record

    Name: string[8];

    Age: Word;

  end;



const FileName = 'C:\Temp\Test.dat';



procedure TForm1.FormCreate(Sender: TObject);

begin

  Button1.Caption := '写复合文件';

  Button2.Caption := '读复合文件';

  Position := poDesktopCenter;

end;



procedure TForm1.Button1Click(Sender: TObject);

const

  Mode = STGM_CREATE or STGM_READWRITE or STGM_SHARE_EXCLUSIVE;

var

  StgRoot, StgSub: IStorage;

  Stm: IStream;

  Rec1: TRec;

begin

  {建立根 IStorage: StgRoot}

  StgCreateDocfile(FileName, Mode, 0, StgRoot);



  {建立子 IStorage: StgSub}

  StgRoot.CreateStorage('StgSub', Mode, 0, 0, StgSub);



  {在子 IStorage: StgSub 中建立 IStream: Stm}

  StgSub.CreateStream('Stm', Mode, 0, 0, Stm);



  {写入数据}

  Rec1.Name := '张三';

  Rec1.Age := 99;

  Stm.Write(@Rec1, SizeOf(TRec), nil);

end;



procedure TForm1.Button2Click(Sender: TObject);

const

  Mode = STGM_READ or STGM_SHARE_EXCLUSIVE;

Var

  StgRoot, StgSub :IStorage;

  Stm: IStream;

  Rec1: TRec;

Begin

  {如果不是结构化存储文件则退出}

  if StgIsStorageFile(FileName) <> S_OK then Exit;



  {获取根 IStorage: StgRoot}

  StgOpenStorage(FileName, nil, Mode, nil, 0, StgRoot);



  {获取子 IStorage: StgSub; 注意: 第一个参数的名称必须和保存时一致}

  StgRoot.OpenStorage('StgSub', nil, Mode, nil, 0, StgSub);



  {获取 IStream: Stm; 注意: 第一个参数的名称必须和保存时一致}

  StgSub.OpenStream('Stm', nil, Mode, 0, Stm);



  {读出数据}

  Stm.Read(@Rec1, SizeOf(TRec), nil);

  ShowMessageFmt('%s, %d', [Rec1.Name, Rec1.Age]);

end;



end.


 
   

窗体文件:

---

object Form1: TForm1

  Left = 0

  Top = 0

  Caption = 'Form1'

  ClientHeight = 107

  ClientWidth = 251

  Color = clBtnFace

  Font.Charset = DEFAULT_CHARSET

  Font.Color = clWindowText

  Font.Height = -11

  Font.Name = 'Tahoma'

  Font.Style = []

  OldCreateOrder = False

  OnCreate = FormCreate

  PixelsPerInch = 96

  TextHeight = 13

  object Button1: TButton

    Left = 32

    Top = 40

    Width = 88

    Height = 25

    Caption = 'Button1'

    TabOrder = 0

    OnClick = Button1Click

  end

  object Button2: TButton

    Left = 134

    Top = 40

    Width = 88

    Height = 25

    Caption = 'Button2'

    TabOrder = 1

    OnClick = Button2Click

  end

end