Category : Pascal Source Code
Archive   : WINTOO.ZIP
Filename : WINTOOLS.PAS

Unit WinTools;
{ WinTools - collection of useful routines for Windows:
o manage huge global memory blocks
(e.g. move, read, write, pointer arithmetic)
o pChar routines

(c) 1991 by Peter Sawatzki
Buchenhof 3, D-5800 Hagen 1, Germany
CompuServe: 10031,3002
FIDO: 2:241/5800.17
BITNET: IN307@DHAFEU11
released to the public domain

revision history: author: change:
1-May-1991 ver.0.1 PS initial version: huge memory unit
23-Aug-1991 ver.0.2 PS change most procedures to operate
on pointers (not on handles)
add several ptr functions
01-Oct-1991 ver.0.3 PS change name from 'HUGEMEM' to 'WINTOOLS'
add simple string routines
add simple message routines
03-Dec-1991 ver.0.4 PS add CenterWindow, FileExist

This unit uses two undocumented windows 'functions':
__AHShift
__AHIncr
both are used by Microsoft C and Borland C to handle the HUGE
memory model, so i think it's ok to use it
}


Interface
Uses
WinTypes;

{-messagebox stuff}
Var
Tmp: Array[0..255] Of Char; {-can be used from other routines}

Procedure Message (Msg: String);
Procedure Error (Msg: String);

Function MaxWord (w1, w2: Word): Word;
Function MinWord (w1, w2: Word): Word;

{-some useful pChar handling}
Function StrForceExtension (Dst, Src, Ext: pChar): pChar;
Function StrDefaultExtension (Dst, Src, ext: pChar): pChar;

{-some useful string handling}
Function HexW (w: Word): String;
Function L2S (l: LongInt): String;
Function W2S (w: Word): String;

{-some file management}
Function FileDelete (aName: PChar): Integer;
Function FileExist (aName: pChar): Boolean;

{-window stuff}
Procedure CenterWindow (hWindow: THandle);

{-huge memory management}
Const
AHi: Word = 8;
AHs: Byte = 3;

Procedure AHIncr;
Procedure AHShift;

Function IncPtr (aPtr: Pointer; anOffset: Word): Pointer;
Function LIncPtr (aPtr: Pointer; anOffset: LongInt): Pointer;
Function DecPtr (aPtr: Pointer; anOffset: Word): Pointer;
Function LDecPtr (aPtr: Pointer; anOffset: LongInt): Pointer;
Function PtrDiff (Ptr1,Ptr2: Pointer): LongInt;
Procedure hMove (srcPtr, dstPtr: Pointer; Size: LongInt);
Procedure hFillChar (aPtr: Pointer; Size: LongInt; aByte: Byte);
Function hRead (Var aFile: File; aPtr: Pointer; Size: LongInt): LongInt;
Function hWrite (Var aFile: File; aPtr: Pointer; Size: LongInt): LongInt;

{-Inline Macros for fast pointer access:}

Function MaxChunk (Size: LongInt): Word;
{-return maximum number of bytes that can be transferred
in one block using conventional functions}
Inline(
$5B/ { Pop Bx ; Word(Size)}
$5A/ { Pop Dx ; Word(Size+2)}
$B8/$FF/$FF/ { Mov Ax,$FFFF}
$09/$D2/ { Or Dx,Dx ; Dx=0 ?}
$75/$02/ { Jne @@1}
$89/$D8); { Mov Ax,Bx}
{@@1: ; Ax=Min($FFFF,Size)}

Function MaxFit (Size: Word; anOffset: Word): Word;
{-return maximum number of bytes that fit in a Segment}
Inline(
$5B/ { Pop Bx ; anOffset}
$58/ { Pop Ax ; Size}
$01/$C3/ { Add Bx,Ax}
$73/$02/ { Jnc @@1}
$29/$D8); { Sub Ax,Bx ; $1.0000-anOffset}
{@@1: ; Ax= Min(Size,$1.0000-anOffset)}

Function IncPtrMac (aPtr: Pointer; anOffset: Word): Pointer;
Inline(
$5B/ { Pop Bx ; anOffset}
$58/ { Pop Ax ; Word(aPtr)}
$5A/ { Pop Dx ; Word(aPtr+2)}
$01/$D8/ { Add Ax,Bx}
$73/$04/ { Jnc @@1}
$03/$16/>AHI); { Add Dx,[>AHi]}
{@@1:}

Function DecPtrMac (aPtr: Pointer; anOffset: Word): Pointer;
Inline(
$5B/ { Pop Bx ; anOffset}
$58/ { Pop Ax ; Word(aPtr)}
$5A/ { Pop Dx ; Word(aPtr+2)}
$29/$D8/ { Sub Ax,Bx}
$73/$04/ { Jnc @@1}
$2B/$16/>AHI); { Sub Dx,[>AHi]}
{@@1:}

Implementation
Uses
WinProcs,
Strings;

{- simple MessageBox stuff ----------------------------}

Procedure Message (Msg: String);
Begin
MessageBox(0,StrPCopy(@Tmp,Msg),'',mb_Ok);
End;

Procedure Error (Msg: String);
Begin
MessageBox(0,StrPCopy(@Tmp,Msg),'Error',mb_Ok);
End;

Function MaxWord (w1, w2: Word): Word;
Begin
If w1>w2 Then
MaxWord:= w1
Else
MaxWord:= w2
End;

Function MinWord (w1, w2: Word): Word;
Begin
If w1 MinWord:= w1
Else
MinWord:= w2
End;

{- some useful PChar handling ------------------------}
Function StrForceExtension (Dst, Src, Ext: pChar): pChar;
Var
p: pChar;
Begin
StrForceExtension:= StrCopy(Dst,Src);
p:= StrRScan(Dst, '.');
If p<>Nil Then p^:= #0;
StrCat(Dst,'.');
StrCat(Dst,Ext);
End;

Function StrDefaultExtension (Dst, Src, ext: pChar): pChar;
Begin
StrDefaultExtension:= StrCopy(Dst,Src);
If StrRScan(Dst,'.')=Nil Then Begin
StrCat(Dst,'.');
StrCat(Dst,Ext)
End
End;

{- some useful string handling -----------------------}

Function HexW (w: Word): String;
Const
HC: Array[0..$F] Of Char = '0123456789ABCDEF';
Begin
HexW:= HC[w Shr 12]
+HC[Hi(w) And $F]
+HC[Lo(w) Shr 4]
+HC[w And $F]
End;

Function L2S (l: LongInt): String;
Var
s: String;
Begin
Str(l,s);
L2S:= s
End;

Function W2S (w: Word): String;
Var
s: String;
Begin
Str(w,s);
W2S:= s
End;


{- some file management ----------------------------}

Function FileDelete(aName : PChar) : Integer; Assembler;
Asm
Push Ds
Lds Dx,aName
Mov Ah,41H
Int 21H
Jc @@1
Xor Ax,Ax
@@1: Neg Ax
Pop Ds
End;

Function FileExist (aName: pChar): Boolean;
Var
f: File;
Begin
FileExist:= False;
If (aName=Nil) Or (aName[0]=#0) Then
Exit;
Assign(f,aName); Reset(f);
If IoResult=0 Then Begin
FileExist:= True;
Close(f)
End
End;

{- window stuff --------------------------------------}

Procedure CenterWindow (hWindow: THandle);
Var
aRect: TRect;
Begin
GetWindowRect(hWindow,aRect);
With aRect Do Begin
Dec(right,left);
Dec(bottom,top);
MoveWindow(hWindow,(GetSystemMetrics(sm_CxScreen)-right) Div 2,
(GetSystemMetrics(sm_CyScreen)-bottom) Div 2,
right, bottom, False)
End
End;

{- huge memory management ----------------------------}

{NOTE:
When using huge memory blocks (e.g. blocks >64k) one must be very careful
not to cross segment boundaries. For example
Move (x^,y^,$8000)
will fail, if Word(x)>=$8001. For this reason it is wise to use hMove
in every case when it is uncertain, if the move couldn't cross
a segment bound!
Do NOT typecast pointers returned from (l)IncPtr/(l)DecPtr like this:
a:= WORD(lIncPtr(aPtr,3)^)
Instead use hMove to move data to/from huge memory blocks:
Move(lIncPtr(aPtr,3)^,a,2);
}

Procedure AHIncr; External 'KERNEL' Index 114; {magic function}
Procedure AHShift; External 'KERNEL' Index 113; {dito}

{ AHincr is 8 in Standard and Enhanced mode, $1000 in real mode.
AHshift is 3 in Standard and Enhanced mode, 12 in real mode
(2^AHshift=AHincr)
}

Function IncPtr (aPtr: Pointer; anOffset: Word): Pointer;
Assembler;
Asm
Mov Dx,Word(aPtr+2)
Mov Ax,Word(aPtr)
Add Ax,anOffset
Jnc @@1
Add Dx,Offset AHincr
@@1:
End;

Function LIncPtr (aPtr: Pointer; anOffset: LongInt): Pointer;
Assembler;
Asm
Mov Dx,Word(anOffset+2)
Mov Ax,Word(anOffset)
Mov Cx,OFFSET AHShift
Shl Dx,Cl
Add Dx,Word(aPtr+2)
Add Ax,Word(aPtr)
Jnc @@1
Add Dx,Offset AHincr
@@1:
End;

Function DecPtr (aPtr: Pointer; anOffset: Word): Pointer;
Assembler;
Asm
Mov Dx,Word(aPtr+2)
Mov Ax,Word(aPtr)
Sub Ax,anOffset
Jnc @@1
Sub Dx,Offset AHincr
@@1:
End;

Function LDecPtr (aPtr: Pointer; anOffset: LongInt): Pointer;
Assembler;
Asm
Mov Bx,Word(anOffset+2)
Mov Cx,Offset AHShift
Shl Bx,Cl
Mov Dx,Word(aPtr+2)
Mov Ax,Word(aPtr)
Sub Dx,Bx
Sub Ax,Word(anOffset)
Jnc @@1
Sub Dx,Offset AHincr
@@1:
End;

Function PtrDiff (Ptr1,Ptr2: Pointer): LongInt;
Assembler;
Asm
Mov Dx,Word(Ptr1+2)
Mov Bx,Word(Ptr2+2)
Mov Cx,Offset AHshift
Shr Dx,Cl
Shr Bx,Cl
Mov Ax,Word(Ptr1)
Sub Ax,Word(Ptr2)
Sbb Dx,Bx
Jnc @@1
Neg Ax
Adc Dx,0
Neg Dx
@@1:
End;

Procedure hMove (srcPtr, dstPtr: Pointer; Size: LongInt);
Var
Count: Word;
Begin
While Size>0 Do Begin
Count:= MaxFit(
MaxFit(MaxChunk(Size),Word(srcPtr))
,Word(dstPtr));
Move(srcPtr^,dstPtr^,Count);
srcPtr:= IncPtrMac(srcPtr,Count);
dstPtr:= IncPtrMac(dstPtr,Count);
Dec(Size,Count)
End
End;

{-hFillChar: fill memory block with aByte}
Procedure hFillChar (aPtr: Pointer; Size: LongInt; aByte: Byte);
Var
Count: Word;
Begin
While Size>0 Do Begin
Count:= MaxFit(MaxChunk(Size),Word(aPtr));
FillChar(aPtr^,Count,aByte);
aPtr:= IncPtrMac(aPtr,Count);
Dec(Size,Count)
End
End;

{-hRW: read/write huge amount of data:
aFile - File to read from/write to
aPtr - pointer to memory (data to read/write)
Size - number of bytes to transfer
rflag - read from file if True, write to file if False
}
Function hRW (Var aFile: File; aPtr: Pointer; Size: LongInt; rflag: Boolean): LongInt;
Var
Count,
Trans: Word;
Transfer: LongInt;
Begin
Transfer:= 0;
While Size>0 Do Begin
Count:= MaxFit(MaxChunk(Size),Word(aPtr));
If rflag Then
BlockRead(aFile, aPtr^, Count, Trans)
Else
BlockWrite(aFile,aPtr^, Count, Trans);
aPtr:= IncPtrMac(aPtr,Count);
Inc(Transfer,Trans);
If Trans Size:= 0
Else
Dec(Size,Count)
End;
hRW:= Transfer
End;

Function hRead (Var aFile: File; aPtr: Pointer; Size: LongInt): LongInt;
Begin
hRead:= hRW(aFile,aPtr,Size,True)
End;

Function hWrite (Var aFile: File; aPtr: Pointer; Size: LongInt): LongInt;
Begin
hWrite:= hRW(aFile,aPtr,Size,False)
End;

Begin
AHi:= Ofs(AHincr);
AHs:= Byte(Ofs(AHshift))
End.