// ① 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 当时没能实现
后来就忘记了这件事情，光啃书了。
有空的时候再尝试一下。
