Windows核心编程 中部分代码 Delphi 实现

// ① Delphi 使用 Interlocked 系列函数
var
  MyValue:Longint = 0; // = Integer
begin
  InterlockedIncrement(MyValue); // + 1 返回值通常不用
  InterlockedDecrement(MyValue); // - 1 返回值通常不用
  InterlockedExchangeAdd(MyValue,10); // + 10
  InterlockedExchangeAdd(PLongint(@MyValue),-10); // - 10 函数 overload
  InterlockedExchange(MyValue,5); // = 5
  iReturnValue := InterlockedCompareExchange(MyValue,4,3); // iReturnValue:Integer;
  ShowMessage('MyValue 跟 3 比，如果相同替换成4，否则返回原值。返回=' + IntToStr(iReturnValue));
end;

// ② 保存成 c:MyFirstMapFile.dat
// SetFilePointer 表示设置当前读写文件的位置
// SetEndOfFile 表示在“当前”位置写上这个文件“结束”。
procedure TForm2.Button1Click(Sender: TObject);
var hFile,hMap:THandle;
begin
  ShellExecute(0,'open','c:',nil,nil,SW_SHOWNORMAL);
  Application.BringToFront;
  ShowMessage('一边执行一边看效果');
  hFile := CreateFile('c:MyFirstMapFile.dat',
    GENERIC_READ or GENERIC_WRITE,
    FILE_SHARE_READ or FILE_SHARE_WRITE,
    nil,
    CREATE_ALWAYS,
    FILE_ATTRIBUTE_NORMAL or FILE_FLAG_DELETE_ON_CLOSE, // 关闭句柄的时候删除
    0);
  ShowMessage('此时，文件 0 大小');
  hMap := CreateFileMapping(hFile,
    nil,PAGE_READWRITE,
    0,
    100,
    nil);
  ShowMessage('此时，文件 100 b');
  CloseHandle(hMap);
  CloseHandle(hFile);
  ShowMessage('最终，文件就是 100 b');
end;

procedure TForm2.Button2Click(Sender: TObject);
var hFile,hMap:THandle;pFile:PByteArray;b:Byte;
begin
  ShowMessage('需要存在 c:MySecondMap.dat' + sLineBreak + '此例子中可以看到虽然内部变量变化了，但是原本的文件并不会变。');
  hFile := CreateFile('c:MySecondMap.dat',
    GENERIC_READ or GENERIC_WRITE,
    0,
    nil,
    OPEN_ALWAYS,
    FILE_ATTRIBUTE_NORMAL,
    0);
  hMap := CreateFileMapping(hFile,
    nil,
    PAGE_WRITECOPY,
    0,
    0,
    nil);
  pFile := MapViewOfFile(hMap,
    FILE_MAP_COPY,
    0,
    0,
    0);
  ShowMessage('以上给予Map WriteCopy 属性');
  b := Byte(pFile[0]);
  if b = Ord('p') then
    Sleep(0);
  ShowMessage('由于没有发生commits，保持属性 Page_WriteCopy');
  pFile[0] := 1;
  ShowMessage('此时，由于出现第一次修改，所以复制一个新Page，并且属性为 Page_ReadWrite( not Page_WriteCopy)');
  pFile[1] := 2;
  ShowMessage('仅修改新复制的页');
  UnmapViewOfFile(pFile);
  ShowMessage('decommits physical storage'+sLineBreak+'新页中的变更丢失');
  CloseHandle(hMap);
  CloseHandle(hFile);
end;

// ③
// 检查 65 的个数
function Count0s(fn:TFileName):Int64;
var
  sinf:SYSTEM_INFO;
  hFile,hMap:THandle;
  dwFileSizeHigh:DWORD;
  qwFileSize,qwFileOffset,qwNumOf0s:Int64;
  dwBytesInBlock:DWORD;
  //pbFile:PAnsiChar;
  dwByte:DWORD;
  pByte:PByteArray;
begin
  // 322357
  // 131071 ?
  GetSystemInfo(sinf);
  hFile := CreateFile(PAnsiChar(fn),
    GENERIC_READ,
    FILE_SHARE_READ,
    nil,
    OPEN_EXISTING,
    FILE_FLAG_SEQUENTIAL_SCAN,
    0);
  hMap := CreateFileMapping(hFile,nil,PAGE_READONLY,0,0,nil);
  qwFileSize := GetFileSize(hFile,@dwFileSizeHigh);
  qwFileSize := Int64(dwFileSizeHigh) shl Int64(32) + Int64(qwFileSize);
  CloseHandle(hFile); // 不再需要，释放
  qwFileOffset := 0;
  qwNumOf0s    := 0;
  while qwFileSize > 0 do
  begin
    dwBytesInBlock := sinf.dwAllocationGranularity;
    if qwFileSize < sinf.dwAllocationGranularity then
      dwBytesInBlock := qwFileSize; // 最后一次取光？
    pByte{pbFile} := MapViewOfFile(hMap,FILE_MAP_READ,
      qwFileOffset shr 32, // Starting byte
      qwFileOffset and $FFFFFFFF, // in file
      dwBytesInBlock);
    for dwByte := 0 to dwBytesInBlock - 1 do
    begin
      if PByte[dwByte] = 65 then
      
//      if Byte(pbFile[dwByte]) = 65 then
        Inc(qwNumOf0s);
    end;
    //pbFile[0] := 'X';
    UnmapViewOfFile(pByte{pbFile});
    Inc(qwFileOffset,dwBytesInBlock);
    Dec(qwFileSize,dwBytesInBlock);
//    Form3.Caption := IntToStr(qwFileSize);
//    Form3.Refresh;
  end;
  CloseHandle(hMap);
  Result := qwNumOf0s;
end;

procedure TForm3.Button1Click(Sender: TObject);
begin
  if OpenDialog1.Execute then
    ShowMessage(IntToStr(Count0s(OpenDialog1.FileName)));
end;

// Win98 & Win2k 不同的机制
procedure TForm3.Button2Click(Sender: TObject);
var
  hFile,hMap:THandle;
  pByte1,pByte2:PAnsiChar;
begin
  if not OpenDialog1.Execute then
    Exit;
  hFile := CreateFile(PAnsiChar(OpenDialog1.FileName),
    GENERIC_READ or GENERIC_WRITE,
    0,
    nil,
    OPEN_ALWAYS,
    FILE_ATTRIBUTE_NORMAL,
    0);
  hMap := CreateFileMapping(hFile,nil,PAGE_READWRITE,0,0,nil);
  pByte1 := MapViewOfFile(hMap,FILE_MAP_Write,0,0,0);
  pByte2 := MapViewOfFile(hMap,FILE_MAP_Write,0,65536,0);
  Inc(pByte1,65536);
  if pByte1 = pByte2 then
    ShowMessage('running under Win98')
  else
    ShowMessage('running under Win2k');
  UnmapViewOfFile(pByte1);
  UnmapViewOfFile(pByte2);
  CloseHandle(hMap);
  CloseHandle(hFile);
end;

// ④ 共享内存的小例子
object Form4: TForm4
  Left = 0
  Top = 0
  Caption = 'Form4'
  ClientHeight = 323
  ClientWidth = 557
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'Tahoma'
  Font.Style = []
  OldCreateOrder = False
  PixelsPerInch = 96
  TextHeight = 13
  object Button1: TButton
    Left = 24
    Top = 72
    Width = 75
    Height = 25
    Caption = #21019#24314
    TabOrder = 0
    OnClick = Button1Click
  end
  object Button2: TButton
    Left = 208
    Top = 72
    Width = 75
    Height = 25
    Caption = #37322#25918
    TabOrder = 1
    OnClick = Button2Click
  end
  object Edit1: TEdit
    Left = 24
    Top = 120
    Width = 297
    Height = 21
    TabOrder = 2
    Text = #32473#19968#20123#27979#35797#25991#23383#21834#65292#27604#22914#35828#32769#23110#25105#29233#20320#20043#31867
  end
  object Button3: TButton
    Left = 24
    Top = 176
    Width = 75
    Height = 25
    Caption = #33719#21462
    TabOrder = 3
    OnClick = Button3Click
  end
  object Edit2: TEdit
    Left = 24
    Top = 224
    Width = 297
    Height = 21
    TabOrder = 4
    Text = 'Edit1'
  end
  object Memo1: TMemo
    Left = 352
    Top = 24
    Width = 185
    Height = 273
    Lines.Strings = (
      #22914#26524#21453#22797#28857#21019#24314#65292
      #21017#37322#25918#30340#26159#26368#21518#19968#20010#21477#26564#65292
      #20294#26159' MM_Name '#36824#26159#23384#22312#65292#25152#20197
      #20877#27425#21019#24314#20250#25552#31034#8220#24050#32463#23384#22312#8221)
    TabOrder = 5
  end
end



unit Unit4;

interface

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

const
  File_Size = 4 * 1024;
  MM_Name = 'MySharedData';

type
  TForm4 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    Edit1: TEdit;
    Button3: TButton;
    Edit2: TEdit;
    Memo1: TMemo;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
  private
    { Private declarations }
  public
    hMap:THandle;
  end;

var
  Form4: TForm4;

implementation

{$R *.dfm}

procedure TForm4.Button1Click(Sender: TObject);
var x,p:PAnsiChar;
begin
  hMap := CreateFileMapping(DWord(-1),nil,PAGE_READWRITE,0,File_Size,MM_Name);
  if hMap <> 0 then
  begin
    if GetLastError = ERROR_ALREADY_EXISTS then
    begin
      ShowMessage('Map 已经存在，不能创建');
      CloseHandle(hMap);
    end
    else begin
      p := MapViewOfFile(hMap,FILE_MAP_READ or FILE_MAP_WRITE,0,0,0);
      if p <> nil then
      begin
        x := PAnsiChar(Edit1.Text);
        Move(x^,p^,StrLen(x));
        UnmapViewOfFile(p);
      end
      else
        ShowMessage('不能得到 map 中的内容');
    end;
  end;
end;

procedure TForm4.Button2Click(Sender: TObject);
begin
  CloseHandle(hMap);
end;

procedure TForm4.Button3Click(Sender: TObject);
var hCopyMap:THandle;p:PAnsiChar;
begin
  hCopyMap := OpenFileMapping(FILE_MAP_READ or FILE_MAP_WRITE,
    false,MM_Name);
  if hCopyMap <> 0 then
  begin
    p := MapViewOfFile(hCopyMap,FILE_MAP_READ or FILE_MAP_WRITE,0,0,0);
    Edit2.Text := StrPas(p);
    UnmapViewOfFile(p);
    CloseHandle(hCopyMap);
  end
  else
    ShowMessage('不能获取内容');
end;

end.



// ⑤ 最强悍的那个应用 CellData 当时没能实现
后来就忘记了这件事情，光啃书了。
有空的时候再尝试一下。