常用自定义函数

做网络程序时, 经常用到内存之间的相互复制转换函数.于是写下了下面一些函数

{-------------------------------------------------------------
单元: BaseFunc
日期: 2003 06 24
作者: 王寒松 Administrator
说明: 一些基础操作函数
--------------------------------------------------------------}
Unit BaseFunc;

Interface
Uses windows, messages, sysutils, classes, controls, stdctrls, variants, comobj;

Function GetPtrSize(p: Pointer): Integer;

//判断指针是否是一个对象, From Amingoo

Function PtrIsObject2(p: Pointer; AClass: TClass;
FindDerived: Boolean = True): Boolean;

//判断一个字符串是否是一个整数 和 try StrtoInt except 相比， 简单实用

Function IsInt(Text: String): Boolean;

//内存处理
Procedure CopyStrToBuf(Str: String; Buf: Pointer; Position: Integer);
Function CopyBufToStr(buf: Pointer; Len: Integer): String;
Procedure StrToArray(Src: String; Dest: Pointer; OffSet: Integer; Len: Integer);
Procedure MoveEx(Source, Dest: Pointer; SrcOffSet: integer; DestOffSet: integer; Count: Integer);
Procedure _VClearMem(PMem: Pointer; MemSize: Integer);
Function _VGetMem(MemSize: Integer): Pointer;
Procedure _VFreeMem(PMem: Pointer; MemSize: Integer);
Function MemoryStreamToOleVariant(Strm: TMemoryStream): OleVariant;
Function OleVariantToMemoryStream(OV: OleVariant): TMemoryStream;

//杂项目
//取得路径信息
Function _ExtractFilePath(FileName: String): String;
//判断有无汉字字符
Function HasHZChar(Str: String): Boolean;

//消息处理
//发送tab 键盘消息
Procedure PostTabKey(WinControl : TWinControl);

Implementation

Function GetPtrSize(p: Pointer): Integer;
Const
cThisUsedFlag = 2;
cPrevFreeFlag = 1;
cFillerFlag = Integer($80000000);
cFlags = cThisUsedFlag Or cPrevFreeFlag Or cFillerFlag;
Type
PUsed = ^TUsed;
TUsed = Packed Record
sizeFlags: Integer;
End;
Var
a: pChar;
Begin
//不验证p 的有效性, 也不进行临界区. 如果p 正在释放, 下面的代码可能导致出错.
//如果是正在分析的内存块, 其长度值还未在PUsed 中填写. 这种情况下, 返回值未知.
a := p;
//当前指针的实际内存块首地址
dec(a, sizeof(TUsed));
//是否是待释放的内存块
If (PUsed(a).sizeFlags And cThisUsedFlag) <> 0 Then
Begin
//取总长度
Result := PUsed(a).sizeFlags And Not cFlags;
If (PUsed(a).sizeFlags And cFillerFlag) = 0 Then //取实际长度
dec(Result, sizeof(TUsed));
End;
End;

Function PtrIsObject2(p: Pointer; AClass: TClass;
FindDerived: Boolean = True): Boolean;
Var
AObject: TObject;
ClassPtr: Pointer;
Begin
If GetPtrSize(p) < 4 Then
Exit;
AObject := TObject(p);
ClassPtr := PPointer(p)^;
Result := (ClassPtr = AClass) Or
(FindDerived And
(Integer(ClassPtr) >= 64 * 1024) And
(PPointer(PChar(ClassPtr) + vmtSelfPtr)^ = Pointer(ClassPtr)) And
(AObject Is AClass));
End;

{-------------------------------------------------------------
过程: IsInt 判断一个字符串是否是整数
日期:2003 09 07
作者: 王寒松 Administrator
参数: Text: string 返回值: 是整数的时候返回真 否则为假
--------------------------------------------------------------}

Function IsInt(Text: String): Boolean;
Var
Code: integer;
TempNumber: integer;
Begin
Val(Text, TempNumber, Code);
Result := Code = 0;
End;

{-----------------------------------------------------------------------------
过程: CopyStrToBuf 拷贝一个字符串的内容到一个buffer中.
例如buffer : array[0..4095] of char; buf := @buffer Position 参数规定从BUFFER的第几个字节开始写STR
作者: Wanghs Administrator
日期: 2003 07 27
参数: Str: string; var Buf : Pointer; Position : Integer;
返回值: Boolean
-----------------------------------------------------------------------------}

Procedure CopyStrToBuf(Str: String; Buf: Pointer; Position: Integer);
Var PC: PChar;
p: Pointer;
Begin
PC := PChar(Str);
P := Pointer(Integer(Buf) + Position);
Move(PC^, P^, Length(Str));
End;

{-------------------------------------------------------------
过程: CopyBufToStr 拷贝一个BUFFER的内容到一个字符串中
日期:2003 09 07
作者: 王寒松 Administrator
参数: buf: Pointer; Len: Integer 返回值: string
--------------------------------------------------------------}

Function CopyBufToStr(buf: Pointer; Len: Integer): String;
Begin
SetString(Result, PChar(buf), Len);
End;

{-----------------------------------------------------------------------------
过程: StrToArray 字符串复制(非赋值)为字符串数组 OffSet 规定从字符串中第几个字符串转换起
作者: Wanghs Administrator 日期: 2003 08 12
参数: Src: string; Dest: Pointer; OffSet: Integer; Len: Integer 返回值: None
-----------------------------------------------------------------------------}

Procedure StrToArray(Src: String; Dest: Pointer; OffSet: Integer; Len: Integer);
Var pc: PChar;
Des: Pointer;
Begin
pc := PChar(SRC);
des := Pointer(Integer(Dest) + OffSet);
system.Move(pc^, Des^, Len);
End;

{-----------------------------------------------------------------------------
过程: MoveEx Move 函数的增强版. 从一个BUF中指定的位置复制指定数量的内容到另一个BUF
作者: Wanghs Administrator 日期: 2003 05 07
参数: Source , Dest : Pointer ; SrcOffSet : integer; DestOffSet : integer; Count : Integer 返回值: None
-----------------------------------------------------------------------------}

Procedure MoveEx(Source, Dest: Pointer; SrcOffSet: integer; DestOffSet: integer; Count: Integer);
Var pSrc, pDes: Pointer;
Begin
pSrc := Pointer(Integer(Source) + SrcOffSet);
pDes := Pointer(Integer(Dest) + DestOffset);
system.Move(PSrc^, pDes^, Count);
End;

{ 过程: _VClearMem 填充一块内存为0 日期:2003 05 07
作者: 王寒松 Administrator
参数: PMem: Pointer; MemSize: Integer 返回值: None }

Procedure _VClearMem(PMem: Pointer; MemSize: Integer);
Begin
Fillchar(PMem, MemSize, 0);
End;

{ 过程: _VGetMem 设置一块虚拟内存 日期:2003 05 07
作者: 王寒松 Administrator
参数: MemSize: Integer 返回值: Pointer }

Function _VGetMem(MemSize: Integer): Pointer;
Begin
Result := VirtualAlloc(0, MemSize, Mem_ReServe Or Mem_Commit, PAGE_READWRITE);
End;

{ 过程: _VFreeMem 释放一块虚拟内存 与 _VGetMem对应
日期:2003 05 07
作者: 王寒松 Administrator
参数: PMem: Pointer; MemSize: Integer 返回值: None }

Procedure _VFreeMem(PMem: Pointer; MemSize: Integer);
Begin
VirtualFree(PMem, MemSize, Mem_DeCommit Or Mem_Release);
End;

{ 过程: _ExtractFilePath 取得一个文件的路径
日期:2003 09 07
作者: 王寒松 Administrator
参数: FileName: string 返回值: string }

Function _ExtractFilePath(FileName: String): String;
Begin
Result := ExtractFilePath(FileName);
If (Result <> '') And (Result[Length(Result)] <> '\') Then
Result := Result + '\';
End;

{-------------------------------------------------------------
过程: HasHZChar
日期: 2003 12 18
作者: 王寒松 Administrator
说明: 判断一个ANSI字符串中是否有汉字字符
--------------------------------------------------------------}

Function HasHZChar(Str: String): Boolean;
Var i: Integer;
Begin
Result := False;
For i := 0 To Length(Str) Do
If ORD(Str[i]) > 127 Then
Begin
Result := True;
Break;
End;
End;

//内存流转换到OLEVARIANT 类型 wanghs 2003-02-10
Function MemoryStreamToOleVariant(Strm: TMemoryStream): OleVariant;
Var
Data: PByteArray;
Begin
Result := VarArrayCreate([0, Strm.Size - 1], varByte);
Data := VarArrayLock(Result);
Try
Strm.Position := 0;
Strm.ReadBuffer(Data^, Strm.Size);
Finally
VarArrayUnlock(Result);
End;
End;

//OleVariant 类型 复制到内存流 wanghs 2003-02-10

Function OleVariantToMemoryStream(OV: OleVariant): TMemoryStream;
Var
Data: PByteArray;
Size: integer;
Begin
Result := TMemoryStream.Create;
Try
Size := VarArrayHighBound(OV, 1) - VarArrayLowBound
(OV, 1) + 1;
Data := VarArrayLock(OV);
Try
Result.Position := 0;
Result.WriteBuffer(Data^, Size);
Finally
VarArrayUnlock(OV);
End;
Except
Result.Free;
Result := Nil;
End;
End;

//对于处于 TFRAME 中的控件， 在处理 回车键 -> TAB键时， 下面的函数要比

// keybdEvent(vk_tab, 0,0,0 ) 和 selectNext , Perform 等 要好用些

Procedure PostTabKey(WinControl : TWinControl);
Begin
if Not Assigned(WinControl.Owner) then Exit;
PostMessage( TWinControl(WinControl.Owner).Handle, WM_KeyDown, VK_Tab, 0);
PostMessage( TWinControl(WinControl.Owner).Handle, WM_KeyUP, VK_Tab, 0);
End;