MyPastebin - View Paste: LvdXK - Description: SOURCE.pas - Author: westor - Language: delphi - Hits: 1,385

Details

ID: LvdXK
Author: westor
Desc: SOURCE.pas
Language: delphi
Size: 4.4KB
Hits: 1386
Public: Yes
Added: 11/9/19 (4y ago)
Last Edited: 11/9/19 (4y ago)
Expires: No

Raw

DL

Copy

Wrap

Details

function smsg(const S: string;i:integer):string;

```
var
```
```
MapFile:Integer;
```
```
Command:Pointer;
```
```
WM:cardinal;
```
```
begin
```
```
wm:=WM_USER+200;
```
```
if (i = 1) then wm:=WM_USER+201;
```

MapFile:=CreateFileMapping(INVALID_HANDLE_VALUE, nil, PAGE_READWRITE, 0, 1024, 'mIRC');

Command:=MapViewOfFile(MapFile, FILE_MAP_ALL_ACCESS, 0, 0, 0);

```
lstrcpy(Command, PChar(S));
```
```
SendMessage(mhwnd,wm,0,0);
```
```
if i = 1 then result:=pchar(command);
```
```
UnmapViewOfFile(Command);
```
```
CloseHandle(MapFile);
```
```
end;
```
```
 
```

Function mIRCProc(wnd:HWnd;msg:Cardinal;wparam,lparam:LongInt):LongInt;stdcall;

```
var
```
```
txt: Array[0..255] of char;
```
```
Begin
```

if (msg = WM_ENABLE) and (idle = 1) then begin

```
idle:=0;
```

smsg('//if ($chan($active)) //window -a $active',0);

```
end
```

else if (msg = WM_ENTERIDLE) and (idle <> 1) then begin

```
GetWindowText(lparam,txt,1000);
```

if (txt = 'mIRC Address Book') then idle:=1;

```
end;
```

result:=callWindowProc(op, wnd, msg, wparam, lparam);

```
end;
```
```
 
```

procedure LoadDll(Info: PLoadInfo); stdcall;

```
begin
```
```
WC:=1;
```
```
idle:=0;
```
```
Info.mKeep := true;
```
```
mhwnd:=info.mHwnd;
```

dmu:=str2int(smsg('$iif($dll(ktools.dll) || $dll(dmu.dll),1,0)',1));

if (dmu = 0) then op:=Pointer(SetWindowLong(info.mHwnd,GWL_WNDPROC,LongInt(@mIRCProc)))

```
else begin
```

smsg('//.timer 1 1 var %t = $input(Dmu.dll or Ktools.dll is already loaded. $cr $+ CNICK.DLL MUST be loaded before these. Please consult the CNICK.dll documentation. $cr $+ CNICK.dll will now be Unloaded,ow,Warning)',0);

```
info.mKeep:=false;
```
```
end;
```
```
end;
```
```
 
```

function UnloadDll(mTimeout: Integer): Integer; stdcall;

```
var i:integer;
```
```
begin
```
```
result:=0;
```
```
if (mTimeout = 0) then begin
```
```
for i:=1 to wc do begin
```

SetWindowLong(p[i].window,GWL_WNDPROC,LongInt(p[i].proc));

```
end;
```

smsg('//if ($chan($active)) //window -a $active',0);

if (dmu = 0) then SetWindowLong(mhwnd,GWL_WNDPROC,LongInt(op));

```
wc:=1;
```
```
result:=1;
```
```
end;
```
```
end;
```
```
 
```

function MakeRect( Left, Top, Right, Bottom: Integer ): TRect; stdcall;

```
begin
```
```
Result.Left:=Left+2;
```
```
Result.Top:=Top;
```
```
Result.Right:=Right;
```
```
Result.Bottom:=Bottom;
```
```
end;
```
```
 
```
```
function states(s,a:cardinal):boolean;
```
```
begin
```
```
result:=false;
```

if (a and ODA_FOCUS <> 0) and (s and ODS_SELECTED <> 0) and (s and ODS_FOCUS <> 0) then result:=true;

if (a and ODA_DRAWENTIRE <> 0) and (s and ODS_SELECTED <> 0) and (s and ODS_FOCUS <> 0) then result:=true;

```
end;
```
```
 
```

Function NlistProc(wnd:HWnd;msg:Cardinal;wparam,lparam:LongInt):LongInt;stdcall;

```
var
```
```
e,c,i,col,ocol,n:integer;
```
```
DIS: PDrawItemStruct;
```
```
r:trect;
```
```
m,s:string;
```
```
CharBuffer: array[0..1024] of Char;
```
```
Begin
```

FillChar(Charbuffer, SizeOf(CharBuffer), #0);

```
Result:=0;
```
```
e:=0;
```
```
n:=1;
```
```
while (p[n].window <> wnd) do n:=n+1;
```
```
if (msg = WM_DRAWITEM) then begin
```
```
DIS:=Pointer(lParam);
```

SendMessage(dis.hwndItem,LB_GETTEXT,dis.itemID,integer(@CharBuffer));

if (dis.itemState and ODS_SELECTED <> 1) then begin

```
m:=copy(charbuffer,1,1);
```

if (m = '!') or (m = '~') or (m = '&') or (m = '@') or (m = '%') or (m = '+') then begin

callWindowProc(p[n].proc,wnd,msg,wparam,lparam);

```
e:=1;
```
```
c:=str2int(smsg('$cnick(0)',1));
```
```
s:='x';
```
```
for i:=1 to c do begin
```
```
s:=smsg('$cnick('+int2str(i)+')',1);
```
```
if (s = m) then break;
```
```
end;
```
```
if (s = m) then begin
```
```
r:=dis.rcItem;
```

r:=MakeRect(r.Left,r.Top,r.Right,r.Bottom);

```
setbkmode(dis.hDC,TRANSPARENT);
```

col:=str2int(smsg('$color($cnick('+int2str(i)+').color)',1));

```
ocol:=settextcolor(dis.hDC,col);
```
```
drawtext(dis.hDC,pchar(m),1,r,0);
```
```
settextcolor(dis.hDC,ocol);
```
```
end;
```
```
end;
```
```
end;
```

if (dis.itemState and ODS_FOCUS <> 0) then begin

```
drawfocusrect(dis.hDC,dis.rcItem);
```
```
e:=1;
```
```
end;
```
```
end;
```

if (e = 0) then Result:=callWindowProc(p[n].proc, wnd, msg, wparam, lparam );

```
End;
```
```
 
```

function GetTok(Str,Num,Tok:string):String;

```
begin
```

result:=smsg('$gettok('+str+','+num+','+tok+')',1);

```
end;
```
```
 
```

FUNCTION JOIN(mWnd: hWnd; aWnd: hWnd; Data: pchar; Parms: PChar;

Show: Boolean; NoPause: Boolean ): Integer; export; stdcall;

```
var
```
```
s:String;
```
```
swnd:hwnd;
```
```
begin
```
```
mhwnd:=mwnd;
```
```
s:='OK';
```

swnd:=str2int(smsg('$window('+Gettok(data,'1','32')+').hwnd',1));

if not(iswindow(swnd)) or (wc > 199) then s:='ERR'

```
else begin
```
```
p[wc].window:=swnd;
```

p[wc].proc:=Pointer(SetWindowLong(swnd,GWL_WNDPROC,LongInt(@NlistProc)));

```
wc:=wc+1;
```
```
end;
```
```
lstrcpy(data, pchar(s));
```
```
result:= 3;
```
```
end;
```
```
 
```
```
exports
```
```
LoadDll,
```
```
UnloadDll,
```
```
JOIN;
```
```
 
```
```
end.
```
```
 
```

0 0 Login to vote.

Login to comment.

library cnick;
uses
  Windows,
  messages;

type
Twin = record
window:hwnd;
proc:pointer;
end;

var
mHwnd:hwnd;
WC,idle,dmu:integer;
op:pointer;
p:array [1..200] of twin;

type LoadInfo = packed record
mVersion: DWORD;
mHwnd: HWND;
mKeep: BOOL;
end;
PLoadInfo =  ^LoadInfo;

function Str2int(s:string) : integer;
var i,e:integer;
begin
val(s,i,e);
result:=i;
end;

function int2str(i:integer) : string;
var s:string;
begin
str(i,s);
result:=s;
end;

function smsg(const S: string;i:integer):string;
var
MapFile:Integer;
Command:Pointer;
WM:cardinal;
begin
wm:=WM_USER+200;
if (i = 1) then wm:=WM_USER+201;
MapFile:=CreateFileMapping(INVALID_HANDLE_VALUE, nil, PAGE_READWRITE, 0, 1024, 'mIRC');
Command:=MapViewOfFile(MapFile, FILE_MAP_ALL_ACCESS, 0, 0, 0);
lstrcpy(Command, PChar(S));
SendMessage(mhwnd,wm,0,0);
if i = 1 then result:=pchar(command);
UnmapViewOfFile(Command);
CloseHandle(MapFile);
end;

Function mIRCProc(wnd:HWnd;msg:Cardinal;wparam,lparam:LongInt):LongInt;stdcall;
var
txt: Array[0..255] of char;
Begin
if (msg = WM_ENABLE) and (idle = 1) then begin
idle:=0;
smsg('//if ($chan($active)) //window -a $active',0);
end
else if (msg = WM_ENTERIDLE) and (idle <> 1) then begin
GetWindowText(lparam,txt,1000);
if (txt = 'mIRC Address Book') then idle:=1;
end;
result:=callWindowProc(op, wnd, msg, wparam, lparam);
end;

procedure LoadDll(Info: PLoadInfo); stdcall;
begin
WC:=1;
idle:=0;
Info.mKeep := true;
mhwnd:=info.mHwnd;
dmu:=str2int(smsg('$iif($dll(ktools.dll) || $dll(dmu.dll),1,0)',1));
if (dmu = 0) then op:=Pointer(SetWindowLong(info.mHwnd,GWL_WNDPROC,LongInt(@mIRCProc)))
else begin
smsg('//.timer 1 1 var %t = $input(Dmu.dll or Ktools.dll is already loaded. $cr $+ CNICK.DLL MUST be loaded before these. Please consult the CNICK.dll documentation. $cr $+ CNICK.dll will now be Unloaded,ow,Warning)',0);
info.mKeep:=false;
end;
end;

function UnloadDll(mTimeout: Integer): Integer; stdcall;
var i:integer;
begin
result:=0;
if (mTimeout = 0) then begin
for i:=1 to wc do begin
SetWindowLong(p[i].window,GWL_WNDPROC,LongInt(p[i].proc));
end;
smsg('//if ($chan($active)) //window -a $active',0);
if (dmu = 0) then SetWindowLong(mhwnd,GWL_WNDPROC,LongInt(op));
wc:=1;
result:=1;
end;
end;

function MakeRect( Left, Top, Right, Bottom: Integer ): TRect; stdcall;
begin
Result.Left:=Left+2;
Result.Top:=Top;
Result.Right:=Right;
Result.Bottom:=Bottom;
end;

function states(s,a:cardinal):boolean;
begin
result:=false;
if (a and ODA_FOCUS <> 0) and (s and ODS_SELECTED <> 0) and (s and ODS_FOCUS <> 0) then result:=true;
if (a and ODA_DRAWENTIRE <> 0) and (s and ODS_SELECTED <> 0) and (s and ODS_FOCUS <> 0) then result:=true;
end;

Function NlistProc(wnd:HWnd;msg:Cardinal;wparam,lparam:LongInt):LongInt;stdcall;
var
e,c,i,col,ocol,n:integer;
DIS: PDrawItemStruct;
r:trect;
m,s:string;
CharBuffer: array[0..1024] of Char;
Begin
FillChar(Charbuffer, SizeOf(CharBuffer), #0);
Result:=0;
e:=0;
n:=1;
while (p[n].window <> wnd) do n:=n+1;
if (msg = WM_DRAWITEM) then begin
DIS:=Pointer(lParam);
SendMessage(dis.hwndItem,LB_GETTEXT,dis.itemID,integer(@CharBuffer));
if (dis.itemState and ODS_SELECTED <> 1) then begin
m:=copy(charbuffer,1,1);
if (m = '!') or (m = '~') or (m = '&') or (m = '@') or (m = '%') or (m = '+') then begin
callWindowProc(p[n].proc,wnd,msg,wparam,lparam);
e:=1;
c:=str2int(smsg('$cnick(0)',1));
s:='x';
for i:=1 to c do begin
s:=smsg('$cnick('+int2str(i)+')',1);
if (s = m) then break;
end;
if (s = m) then begin
r:=dis.rcItem;
r:=MakeRect(r.Left,r.Top,r.Right,r.Bottom);
setbkmode(dis.hDC,TRANSPARENT);
col:=str2int(smsg('$color($cnick('+int2str(i)+').color)',1));
ocol:=settextcolor(dis.hDC,col);
drawtext(dis.hDC,pchar(m),1,r,0);
settextcolor(dis.hDC,ocol);
end;
end;
end;
if (dis.itemState and ODS_FOCUS <> 0) then begin
drawfocusrect(dis.hDC,dis.rcItem);
e:=1;
end;
end;
if (e = 0) then Result:=callWindowProc(p[n].proc, wnd, msg, wparam, lparam );
End;

function GetTok(Str,Num,Tok:string):String;
begin
result:=smsg('$gettok('+str+','+num+','+tok+')',1);
end;

FUNCTION JOIN(mWnd: hWnd; aWnd: hWnd; Data: pchar; Parms: PChar;
Show: Boolean; NoPause: Boolean ): Integer; export; stdcall;
var
s:String;
swnd:hwnd;
begin
mhwnd:=mwnd;
s:='OK';
swnd:=str2int(smsg('$window('+Gettok(data,'1','32')+').hwnd',1));
if not(iswindow(swnd)) or (wc > 199) then s:='ERR'
else begin
p[wc].window:=swnd;
p[wc].proc:=Pointer(SetWindowLong(swnd,GWL_WNDPROC,LongInt(@NlistProc)));
wc:=wc+1;
end;
lstrcpy(data, pchar(s));
result:= 3;
end;

exports
LoadDll,
UnloadDll,
JOIN;

end.