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

// ① Delphi 使用 Interlocked 系列函数
var
  MyValue:Longint = ; // = Integer
begin
  InterlockedIncrement(MyValue); // +  返回值通常不用
  InterlockedDecrement(MyValue); // -  返回值通常不用
  InterlockedExchangeAdd(MyValue,); // +
  InterlockedExchangeAdd(PLongint(@MyValue),-); // -  函数 overload
  InterlockedExchange(MyValue,); // =
  iReturnValue := InterlockedCompareExchange(MyValue,,); // 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(,'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, // 关闭句柄的时候删除
    );
  ShowMessage('此时，文件 0 大小');
  hMap := CreateFileMapping(hFile,
    nil,PAGE_READWRITE,
    ,
    ,
    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,
    ,
    nil,
    OPEN_ALWAYS,
    FILE_ATTRIBUTE_NORMAL,
    );
  hMap := CreateFileMapping(hFile,
    nil,
    PAGE_WRITECOPY,
    ,
    ,
    nil);
  pFile := MapViewOfFile(hMap,
    FILE_MAP_COPY,
    ,
    ,
    );
  ShowMessage('以上给予Map WriteCopy 属性');
  b := Byte(pFile[]);
  if b = Ord('p') then
    Sleep();
  ShowMessage('由于没有发生commits，保持属性 Page_WriteCopy');
  pFile[] := ;
  ShowMessage('此时，由于出现第一次修改，所以复制一个新Page，并且属性为 Page_ReadWrite( not Page_WriteCopy)');
  pFile[] := ;
  ShowMessage('仅修改新复制的页');
  UnmapViewOfFile(pFile);
  ShowMessage('decommits physical storage'+sLineBreak+'新页中的变更丢失');
  CloseHandle(hMap);
  CloseHandle(hFile);
end;

// ③
// 检查  的个数
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
  //
  //  ?
  GetSystemInfo(sinf);
  hFile := CreateFile(PAnsiChar(fn),
    GENERIC_READ,
    FILE_SHARE_READ,
    nil,
    OPEN_EXISTING,
    FILE_FLAG_SEQUENTIAL_SCAN,
    );
  hMap := CreateFileMapping(hFile,nil,PAGE_READONLY,,,nil);
  qwFileSize := GetFileSize(hFile,@dwFileSizeHigh);
  qwFileSize := Int64(dwFileSizeHigh) shl Int64() + Int64(qwFileSize);
  CloseHandle(hFile); // 不再需要，释放
  qwFileOffset := ;
  qwNumOf0s    := ;
  while qwFileSize >  do
  begin
    dwBytesInBlock := sinf.dwAllocationGranularity;
    if qwFileSize < sinf.dwAllocationGranularity then
      dwBytesInBlock := qwFileSize; // 最后一次取光？
    pByte{pbFile} := MapViewOfFile(hMap,FILE_MAP_READ,
      qwFileOffset shr , // Starting byte
      qwFileOffset and $FFFFFFFF, // in file
      dwBytesInBlock);
    for dwByte :=  to dwBytesInBlock -  do
    begin
      if PByte[dwByte] =  then

//      if Byte(pbFile[dwByte]) =  then
        Inc(qwNumOf0s);
    end;
    //pbFile[] := '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,
    ,
    nil,
    OPEN_ALWAYS,
    FILE_ATTRIBUTE_NORMAL,
    );
  hMap := CreateFileMapping(hFile,nil,PAGE_READWRITE,,,nil);
  pByte1 := MapViewOfFile(hMap,FILE_MAP_Write,,,);
  pByte2 := MapViewOfFile(hMap,FILE_MAP_Write,,,);
  Inc(pByte1,);
  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 =
  Top =
  Caption = 'Form4'
  ClientHeight =
  ClientWidth =
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -
  Font.Name = 'Tahoma'
  Font.Style = []
  OldCreateOrder = False
  PixelsPerInch =
  TextHeight =
  object Button1: TButton
    Left =
    Top =
    Width =
    Height =
    Caption = ##
    TabOrder =
    OnClick = Button1Click
  end
  object Button2: TButton
    Left =
    Top =
    Width =
    Height =
    Caption = ##
    TabOrder =
    OnClick = Button2Click
  end
  object Edit1: TEdit
    Left =
    Top =
    Width =
    Height =
    TabOrder =
    Text = ###################
  end
  object Button3: TButton
    Left =
    Top =
    Width =
    Height =
    Caption = ##
    TabOrder =
    OnClick = Button3Click
  end
  object Edit2: TEdit
    Left =
    Top =
    Width =
    Height =
    TabOrder =
    Text = 'Edit1'
  end
  object Memo1: TMemo
    Left =
    Top =
    Width =
    Height =
    Lines.Strings = (
      ########
      ############
      ##' MM_Name '#######
      #############)
    TabOrder =
  end
end

unit Unit4;

interface

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

const
  File_Size =  * ;
  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(-),nil,PAGE_READWRITE,,File_Size,MM_Name);
  if hMap <>  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,,,);
      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 <>  then
  begin
    p := MapViewOfFile(hCopyMap,FILE_MAP_READ or FILE_MAP_WRITE,,,);
    Edit2.Text := StrPas(p);
    UnmapViewOfFile(p);
    CloseHandle(hCopyMap);
  end
  else
    ShowMessage('不能获取内容');
end;

end.

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