home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
High Voltage Shareware
/
high1.zip
/
high1
/
DIR4
/
V12N19.ZIP
/
FILCDR.ZIP
/
FILECDRL.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1993-07-02
|
4KB
|
130 lines
{$K+}
LIBRARY FileCdrL;
USES WinTypes, Strings, WinProcs;
{$D Copyright (c) 1993 by Neil J. Rubenking}
CONST
WM_FILESYSCHANGE = $0034;
hWndInUse : hWnd = 0;
FUNCTION FileCdr(FILECDRPROC : TFarProc) : LongInt; FAR;
EXTERNAL 'KERNEL' Index 130;
PROCEDURE FileCdrProc(wActionCode : Word; lpszPath : PChar);Export;
BEGIN
SendMessage(hWndInUse, WM_FILESYSCHANGE, Hi(wActionCode),
LongInt(lpszpath));
END;
FUNCTION FileCdrInstall(H : hWnd) : Bool; Export;
BEGIN
FileCdrInstall := FALSE;
IF hWndInUse <> 0 THEN Exit;
IF NOT Bool(LoWord(FileCdr(@FileCdrProc))) THEN Exit;
hWndInUse := H;
FileCdrInstall := TRUE;
END;
FUNCTION FileCdrUninstall(H : hWnd) : Bool; Export;
BEGIN
FileCdrUninstall := FALSE;
IF hWndInUse = 0 THEN Exit;
IF hWndInUse <> H THEN Exit;
FileCdr(NIL);
hWndInUse := 0;
FileCdrUninstall := TRUE;
END;
FUNCTION GetEventName(buff : PChar; fEvent, buffLen :
Word) : PChar; Export;
BEGIN
CASE fEvent OF
0, $3C : StrLCopy(buff, 'Create file', BuffLen);
1, $41 : StrLCopy(buff, 'Delete file', BuffLen);
2, $56 : StrLCopy(buff, 'Rename file/dir', BuffLen);
3, $43 : StrLCopy(buff, 'Get/set file attrs', BuffLen);
{no event for GET file attr from a WinApp}
$5A : StrLCopy(buff, 'Create unique file', BuffLen);
{from DOS box, this function comes as 0}
$57 : StrLCopy(buff, 'Set file date/time', BuffLen);
{Schulman mentions this, but it don't happen}
$5B : StrLCopy(buff, 'Create new file', BuffLen);
{from DOS box, this function comes as 0}
7, $39 : StrLCopy(buff, 'Create directory', BuffLen);
8, $3A : StrLCopy(buff, 'Delete directory', BuffLen);
$6C : StrLCopy(buff, 'Extended open', BuffLen);
{from DOS box, this function is ignored}
ELSE StrLCopy(buff, 'UNKNOWN', BuffLen);
END;
GetEventName := buff;
END;
(* Code for Visual BASIC support begins here *)
CONST TextHandle : hWnd = 0;
VAR OldProc : TFarProc;
PROCEDURE SendVbMessage(wAc : Word; lpszPath : PChar);
{used by both FileCdrProcVB and NewVBWinProc}
VAR
Len, fBegin : Word;
P : PChar;
BEGIN
Len := StrLen(lpszpath) + 30;
CASE wAc OF
2, $56 : Inc(Len, StrLen(StrEnd(lpszpath)+1));
END;
GetMem(P, Len);
{start with W for Windows or D for DOS box}
IF wAc > 9 THEN StrCopy(P, '(W)'#9) ELSE StrCopy(P, '(D)'#9);
{insert the event name starting at 4th char}
GetEventName(P+4, wAc, Len);
fBegin := StrLen(P);
StrCat(P, #9);
{append the file name}
StrCat(P, lpszpath);
{if RENAME, append the OTHER file name}
IF (wAc = 2) OR (wAc = $56) THEN
BEGIN
StrCat(P, ' TO ');
StrCat(P, StrEnd(lpszpath)+1);
END;
{uppercase the filename portion only}
StrUpper(P + fBegin);
SendMessage(TextHandle, WM_SETTEXT, 0, LongInt(P));
FreeMem(P, Len);
END;
PROCEDURE FileCdrProcVB(wActionCode: Word; lpszPath: PChar); Export;
BEGIN
IF hWndInUse = 0 THEN Exit;
SendVbMessage(Hi(wActionCode), lpszPath);
END;
FUNCTION NewVBWinProc(Window : hWnd; Message, wParam : Word;
lParam : LongInt) : LongInt; EXPORT;
BEGIN
NewVBWinProc := CallWindowProc(OldProc, Window, Message, wParam,
lParam);
IF Message = WM_FILESYSCHANGE THEN
SendVBMessage(wParam, PChar(lParam));
END;
FUNCTION FileCdrInstallVB(H, TextH : hWnd) : Bool; Export;
BEGIN
FileCdrInstallVB := FALSE;
IF hWndInUse <> 0 THEN Exit;
IF NOT Bool(LoWord(FileCdr(@FileCdrProcVB))) THEN Exit;
hWndInUse := H;
TextHandle := TextH;
OldProc := TFarProc(GetWindowLong(hWndInUse, gwl_WndProc));
SetWindowLong(hWndInUse, gwl_WndProc, LongInt(@NewVBWinProc));
FileCdrInstallVB := TRUE;
END;
EXPORTS
FileCdrInstall INDEX 1,
FileCdrUnInstall INDEX 2,
GetEventName INDEX 3,
FileCdrInstallVB INDEX 4;
BEGIN
END.