復雜的結構化存取(二)

本例效果圖:

　　代碼文件:

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:TempTest.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