1,183
社区成员
发帖
与我相关
我的任务
分享
unit MyMemo;
interface
uses
System.SysUtils,
Windows, System.Classes;
type
TMyMemo = class
private const
FDebug: Boolean = true;
private
FSize: Integer;
FPMemo: pointer;
FLogfile: TStringList;
procedure FDebugOut(const BugText: String);
public
Used: Integer;
constructor Create(Num: Integer);
destructor Destroy; override;
property Size: Integer read FSize;
property PMemo: pointer read FPMemo;
function Write(const Buf: pointer; Num: Integer): Integer;
function Read(Num: Integer): String;
function Buf_Read(out Save_Buf: Integer): Boolean;
procedure Cute(Num: Integer);
end;
const
Buf_head = #2 + '0302+';
Buf_tail = #3;
Lpos = 14;
implementation
constructor TMyMemo.Create(Num: Integer);
begin
inherited Create;
FPMemo := AllocMem(Num);
FSize := Num - 1;
Used := 0;
if FDebug then
// begin
FLogfile := TStringList.Create;
// TThread.CreateAnonymousThread(
// procedure
// var
// OldCount: Integer;
// begin
// OldCount := FLogfile.Count;
// while True do
// begin
// Sleep(1);
// if OldCount <> FLogfile.Count then
// FLogfile.SaveToFile('C:\debug.txt');
// OldCount := FLogfile.Count;
// end;
// end).Start;
// end;
end;
destructor TMyMemo.Destroy;
begin
if FDebug then
FLogfile.Free;
FreeMem(FPMemo);
inherited Destroy;
end;
procedure TMyMemo.FDebugOut(const BugText: String);
begin
FLogfile.Add(Format('%d: %s', [GetTickCount, BugText]));
end;
function TMyMemo.Write(const Buf: pointer; Num: Integer): Integer;
begin
Result := 1;
if Num > Size - Used then
begin
Result := 0;
exit;
end;
Move(Buf^, ptr(LongWord(PMemo) + Used)^, Num);
Used := Used + Num;
if FDebug then
FDebugOut(Format('Calling Write, Size: %d Used: %d', [Num, Used]));
end;
function TMyMemo.Read(Num: Integer): String;
begin
Result := '';
if Num > Used then
begin
raise Exception.Create('No so much to read!');
exit;
end;
if FDebug then
FDebugOut(Format('Using Read, From: %d To: %d Used: %d',
[LongWord(PMemo) + Num, LongWord(PMemo), Used]));
Result := Copy(Pansichar(PMemo), 0, Num);
Cute(Num);
end;
procedure TMyMemo.Cute(Num: Integer);
begin
if Num > Used then
begin
raise Exception.Create('No so much to cute!');
exit;
end;
if Used + Num > Size then
begin
raise Exception.Create('MyMemo is used up!');
exit;
end;
if FDebug then
FDebugOut(Format('Using Cut, From: %d To: %d Used: %d',
[LongWord(PMemo) + Num, LongWord(PMemo), Used]));
Move(ptr(LongWord(PMemo) + Num)^, PMemo^, Used);
Used := Used - Num;
end;
function TMyMemo.Buf_Read(out Save_Buf: Integer): Boolean;
var
Pos_over: Integer;
Buf: ansiString;
begin
Result := false;
Pos_over := Pos(Buf_tail, Pansichar(PMemo));
while (Pos_over > 0) do
begin
if Pos_over > Lpos then
Cute(Pos_over - Lpos) // 86
else if Pos_over < Lpos then
Cute(Length(Buf_tail) + Pos_over - 1)
else
begin // 86
if FDebug then
FDebugOut(Format('Calling COPY, Begin: %d, Length: %d',
[Pos_over - Lpos, Length(Buf_head)]));
Buf := Copy(Pansichar(PMemo), Pos_over - Lpos, Length(Buf_head));
if FDebug then
FDebugOut(Format('Begin P2, BUF: %s', [Buf]));
if Buf <> Buf_head then
Cute(Length(Buf_tail) + Pos_over - 1)
else
begin
Cute(Length(Buf_head));
Buf := Read(Pos_over - Length(Buf_head) - 1);
Cute(Length(Buf_tail));
try
if FDebug then
FDebugOut(Format('Begin P3, BUF: %s', [Buf]));
Save_Buf := StrToInt(Buf);
Result := true;
break;
except
end;
end;
end;
Pos_over := Pos(Buf_tail, Pansichar(PMemo));
sleep(1);
if FDebug then
FDebugOut(Format('New while, Pos: %d', [Pos_over]));
end;
end;
end.
function TMyMemo.Read(Num: Integer): AnsiString; //最好定义为AnsiString
begin
Result := '';
if .....
//Result := Copy(Pansichar(PMemo), 0, Num);改成以下代码
SetLength(Result , Num);
Move(PMemo^ , Pointer(Result)^ , Num);
Cute(Num);
end;
后面的Buf_Read函数也需要修改,可以写一个内存位置搜索的函数来代替Pos