{********************************************************

 SlavaNap source code.

 Copyright 2001,2002 by SlavaNap development team
 Released under GNU General Public License

 Latest version is available at
 http://www.slavanap.org

**********************************************************

 Unit: stypes (was: types.pas)

 SlavaNap types

*********************************************************}
unit stypes;

interface

uses
 Windows, Classes, Classes2, SysUtils, constants, md5, blcksock, winsock, Graphics,
 slavastrings, class_cmdlist, class_cmdexlist, class_doublecmdlist;

{$I defines.pas}

type
  time_t          = LongWord;
  Bool3           = (Unknown3, True3, False3);
  ConfigLoadMode  = (lmInitial, lmRest, lmAll);
  TQuery          = (queryNormal, queryOperServ, queryNickServ, queryChanServ,
                     queryMsgServ, queryChannel, queryServer, queryRemoteUser);
  TUserState      = set of (userMuzzled, // user is muzzled
                            userChatting, // user is chatting in channel
                            userHideErrors, // usermode ERROR - hide error messages
                            userHideAnnouncements, // usermode ANNOUNCE - hide announcements
                            // for mods+ only
                            userCloaked, // user is cloaked
                            {userHideBans, // usermode BAN - hide ban/unban messages}
                            userHideSBans, // usermode SBAN - hide server ban/unban messages (minsharing and changed mx)
                            userHideSBanConn, // usermode SBANCONN - hide messages about connection attempts banned by server bans
                            userHideMBans, // usermode MBAN - hide ban/unban messages about bans from mod+ (NOT server)
                            userHideMBanConn, // usermode MBANCONN - hide messages about connection attempts banned by mod+ bans   
                            userHideChange, // usermode CHANGE - hide messages about changes in user info
                            userHideKill, // usermode KILL - hide kill/nuke messages
                            userHideLevel, // usermode LEVEL - hide notifications about user's level change
                            userHideServer, // usermode SERVER - hide server link messages
                            userHideMuzzle, // usermode MUZZLE - hide muzzle/unmuzzle notifications
                            userHidePort, // usermode PORT - hide dataport changes
                            userHideWallop, // usermode WALLOP - hide wallop messages
                            userHideCloak, // usermode CLOAK - hide cloak/uncloak messages
                            userHideFlood, // usermode FLOOD - hide flood protection messages
                            userHidePM, // usermode MSG - hide private messages
                            userHideWhois, // usermode WHOIS - hide whois notifications
                            userHideFriends, // usermode FRIEND - hide messages about friends list
                            userHideChannel, // usermode CHANNEL - hide messages about channel bans, clearing or dropping channels, op/deop...
                            userHideRegister, // usermode REGISTER - hide notifications about new registrations on server
                            userHideVar, // usermode VAR - hide changes in server config
                            userHideBrowse, // usermode BROWSE - hide browse notifications
                            userHidePing, // usermode PING - hide ping/pong notifications
                            userHideMotd, // usermode MOTD - hide MOTD
                            userHideLeech, // usermode LEECH - hide notification of leech logins
                            userHideSameNic); // usermode SAMENIC - hide 748 error
  TConsoleList    = (consFriends, consIgnored, consBlocks);
  TBlockedMessageType = (blckNone, blckCustom, blckDefault);
  TWallopType     = (wallopWallop,  // userHideWallop
                     {wallopBan, // userHideBans}
                     wallopSBan, // userHideSBans
                     wallopSBanConn, // userHideSBanConn
                     wallopMBan, // userHideMBans
                     wallopMBanConn, // userHideMBanConn
                     wallopChange, // userHideChange
                     wallopKill, // userHideKill
                     wallopLevel, // userHideLevel
                     wallopServer, // userHideServer
                     wallopMuzzle, // userHideMuzzle
                     wallopPort, // userHidePort
                     wallopCloak, // userHideCloak
                     wallopFlood, // userHideFlood
                     wallopWhois, // userHideWhois
                     wallopFriends, // userHideFriends
                     wallopAnnouncement, // userHideAnnouncement
                     wallopChannel, // userHideChannel
                     wallopRegister, // userHideRegister
                     wallopVar, // userHideVar
                     wallopPing, // userHidePing
                     wallopMotd, // userHideMotd
                     wallopLeech); // userHideLeech
  TNapSpeed       = (napSpeedUnknown,   napSpeed14,      napSpeed28,
                     napSpeed33,        napSpeed56,      napSpeed64ISDN,
                     napSpeed128ISDN,   napSpeedCable,   napSpeedDSL,
                     napSpeedT1,        napSpeedT3);
  TNapUserLevel   = (napUserLeech,      napUserUser,     napUserModerator,
                     napUserAdmin,      napUserElite,    napUserConsole);
  TNapCompare     = (napNoCompare,      napAtLeast,        napEqual,        napAtBest);
  TNapMimeType    = (napTypeAny,        napTypeMP3,        napTypeAudio,    napTypeVideo,
                     napTypeText,       napTypeImage,      napTypeApplication);
  TSearchStruct = record
    include   : String;
    exclude   : String;
    max       : Word; // MAX_RESULTS
    mime      : Integer; // TYPE
    speed_cmp : TNapCompare; // LINESPEED
    speed     : TNapSpeed;
    bitrate_cmp: TNapCompare; // BITRATE
    bitrate   : Word;
    frequency_cmp: TNapCompare; // FREQ
    frequency : Integer;
    size_cmp  : TNapCompare; // SIZE
    size      : Int64;
    time_cmp  : TNapCompare; // DURATION
    time      : Integer;
    local     : Boolean; // LOCAL_ONLY
    nonmp3    : Boolean; // for WinMX search
    ext_soft  : Boolean; // for GroundLevel only - add software to list
    ext_queue : Boolean; // for CQ_EX only - add queue status to list
  end;
  
function  CanReceive(server: Boolean): Boolean;
function  CanSend(server: Boolean): Boolean;
procedure CheckBandwidthTime;
function  HexData(str: String): String;
function  HexData2(str: String): String;
function  Hex2Str(str: String): String;
function  isDigit(str: String): Boolean;
function  GetDigit(str: String): String;
function  Compare2Str(cmp: TNapCompare): String;
function  Str2Compare(str: String): TNapCompare;
function  ConvertCompare(str: String): String;
function  Speed2Str(spd: TNapSpeed): String;
function  Str2Speed(str:String): TNapSpeed;
function  MimeType2Str(value: TNapMimeType): String;
function  Str2MimeType(str:String): TNapMimeType;
function  TrimSpaces(str: String): String;
function  NextParam(str:String; num: Integer=1): String;
function  FirstParam(str: String): String;
function  SplitStringOld(str:String; lst:TMyStringList):Integer; overload;
function  SplitString(str:String; lst:TMyStringList):Integer; overload;
function  SplitString(str:String; var hash:TStringHash):Integer; overload;
function  JoinString(list: TMyStringList): String; overload;
function  JoinString(hash: TStringHash): String; overload;
function  NextParamEx(str:String; num: Integer=1): String;
function  GetMimeType(filename:String): TNapMimeType;
function  Level2Str(value: TNapUserLevel): String;
function  Str2Level(value: String):TNapUserLevel;
function  compare(cmp: TNapCompare; et: Integer; src: Integer): Boolean;
function  decode_ip(Value: String):String; overload;
function  decode_ip(Value: Cardinal):String; overload;
function  encode_ip_str(str:String):String;
function  encode_ip(str:String):LongWord;
function  encode_ip_rev(str:String):String;
function  index_ip(ip: Cardinal): Integer;
function  IPisLocal(str: String): Boolean;
function  UnixTimeToDateTime(time: time_t): TDateTime;
function  DateTimeToUnixTime(time: TDateTime): time_t;
function  UnixTimeToStr(t: time_t): String;
function  StrToUnixTime(str: String): time_t;
function  StrToUnixTimeDef(str: String; def: time_t): time_t;
function  GetTickCountT: time_t;
function  FileSize(const FileName: string): Integer;
function  NapCmd(id: Integer; cmd: String): TNapCmd;
function  NapCmdEx(id: Integer; cmd: String; data: String): TNapCmdEx;
function  NapDoubleCmd(id1,id2: Integer;cmd1,cmd2: String): TNapDoubleCmd;
function  GetLogTime: String;
procedure Log(id: Integer; cmd: String; file_only: Boolean=false);
procedure DebugLog(cmd: String; file_only: Boolean=false);
procedure LogConsole(id: Integer; cmd: String);
function  IntToStrDot(Value: Integer): String; overload;
function  IntToStrDot(Value: Int64): String; overload;
procedure ReplaceString(var source: String;old,new: String);
function  StripString(str: String;minus: Boolean=false): String;
function  MatchesList(list: TMyStringList; str: String): Integer;
function  encode(src:String; complete: Boolean=true):String;
function  null_pass: String;
function  check_name(str:String; ignore: Boolean=false):Boolean;
function  check_software(str: String): Boolean;
function  check_port(port: Integer): Boolean;
function  channelname(str: String):String;
function  GetIndex(list: TMyStringList; str: String; ignore_case: Boolean): Integer;
procedure check_name_key(var Key: Char);
function  SocketError(i: Integer):String;
function  isLevel(value: String): Boolean;
function  min(a,b: Integer): Integer; overload;
function  min(a,b: Int64): Int64; overload;
function  max(a,b: Integer): Integer; overload;
function  max(a,b: Int64): Int64; overload;
function  CountColor(c1,c2: TColor; n1,n2: Integer): TColor;
function  GetRealString(text:String):String;
procedure SlavaDrawText(Canvas:TCanvas;text:String;p:TPoint;color1,color2,color3: TColor);
procedure GradientFill(DC : HDC; R : TRect; StartColor, EndColor : TColor; Steps : integer; Vertical : boolean);
function  AddStr(str: String): String;
function  Str2Bool(str: String; def: Boolean): Boolean;
function  GetSoftware(str: String): Integer;
function  MatchesMaskEx(s,mask:string):Boolean;
//function  MatchesMaskEx(const Filename, Mask: string): Boolean;
function  UserState2Int(state: TUserState): Integer;
function  Int2UserState(n: Integer; chatting: Boolean): TUserState;
function  Color2HTML(c: Integer): String;
procedure StartLogStartup;
procedure LogStartup(str: String);
function  Time2Str(t: time_t): String;
function  Str2Time(str: String): time_t;
function  SetSocketCloseTime: Cardinal;
function  StringCRC(str: String; lower_case: Boolean): Word;
procedure MataParaEncrypt(var DB: TStringHash; const PassWord, FileName: String);
procedure MataParaDecrypt(var DB: TStringHash; const PassWord, FileName: String);
function IsCrypted(FileName: String): Boolean;

var
 levels: Array[0..5] of String;
 bandwidth_checkcount: Integer;
 StartupLogFile: String;


implementation

uses
 vars, thread, SlavaMasks, memory_manager, crypt;

{* * * * * Other functions * * * * *}

function ConvertCompare(str: String): String;
begin
  Result:=Compare2Str(Str2Compare(str));
end;

function Compare2Str(cmp: TNapCompare): String;
begin
  case cmp of
    napAtLeast: Compare2Str:=' "AT LEAST" ';
    napEqual: Compare2Str:=' "EQUAL TO" ';
    napAtBest: Compare2Str:=' "AT BEST" ';
    napNoCompare: Compare2Str:='';
  end;
end;

function Str2Compare(str: String): TNapCompare;
begin
 Result:=napNoCompare;
 str:=uppercase(str);
 if pos('LEAST',str)<>0 then Result:=napAtLeast;
 if pos('EQUAL',str)<>0 then Result:=napEqual;
 if pos('BEST',str)<>0 then Result:=napAtBest;
end;

function Speed2Str(spd: TNapSpeed): String;
begin
 case spd of
  napSpeed14:          Result:='14.4';
  napSpeed28:          Result:='28.8';
  napSpeed33:          Result:='33.6';
  napSpeed56:          Result:='56K';
  napSpeed64ISDN:      Result:='ISDN-64K';
  napSpeed128ISDN:     Result:='ISDN-128K';
  napSpeedCable:       Result:='Cable';
  napSpeedDSL:         Result:='DSL';
  napSpeedT1:          Result:='T1';
  napSpeedT3:          Result:='T3';
  else                 Result:='Unknown';
 end;
end;

function Str2Speed(str:String): TNapSpeed;
begin
 result:=napSpeedUnknown;
 str:=lowercase(str);
 if isDigit(str) then
 begin
  Result:=TNapSpeed(StrToIntDef(str,0));
  exit;
 end;
 if pos('14',str)<>0 then result:=napSpeed14;
 if pos('28',str)<>0 then result:=napSpeed28;
 if pos('33',str)<>0 then result:=napSpeed33;
 if pos('56',str)<>0 then result:=napSpeed56;
 if pos('64',str)<>0 then result:=napSpeed64ISDN;
 if pos('128',str)<>0 then result:=napSpeed128ISDN;
 if pos('cable',lowercase(str))<>0 then result:=napSpeedCable;
 if pos('dsl',lowercase(str))<>0 then result:=napSpeedDSL;
 if pos('t1',lowercase(str))<>0 then result:=napSpeedT1;
 if pos('t3',lowercase(str))<>0 then result:=napSpeedT3;
end;

function MimeType2Str(value: TNapMimeType): String;
begin
 case value of
   napTypeAny:   Result:='any';
   napTypeMP3:   Result:='mp3';
   napTypeAudio: Result:='audio';
   napTypeVideo: Result:='video';
   napTypeText:  Result:='text';
   napTypeImage: Result:='image';
   napTypeApplication: Result:='application';
 end;
end;

function Str2MimeType(str:String): TNapMimeType;
begin
 str:=lowercase(str);
 Result:=napTypeMP3;
 if pos('audio',str)<>0 then Result:=napTypeAudio;
 if pos('video',str)<>0 then Result:=napTypeVideo;
 if pos('text',str)<>0 then Result:=napTypeText;
 if pos('image',str)<>0 then Result:=napTypeImage;
 if pos('app',str)<>0 then Result:=napTypeApplication;
 if pos('any',str)<>0 then Result:=napTypeAny;
end;

function  Level2Str(value: TNapUserLevel): String;
begin
 Result:=levels[Ord(value)];
end;

function isLevel(value: String): Boolean;
var
 i: Integer;
begin
 Result:=true;
 value:=AnsiLowerCase(value);
 if Length(value)=1 then
 begin
   i:=StrToIntDef(value,-1);
   if (i<0) or (i>5) then Result:=false;
   exit;
 end;
 for i:=0 to 4 do
  if AnsiLowerCase(levels[i])=value then exit;
 if value='leech' then exit;
 if value='moderator' then exit;
 if value='admin' then exit;
 if value='administrator' then exit;
 if value='elite' then exit;
 if value='console' then exit;
 Result:=false;
end;

function  Str2Level(value: String):TNapUserLevel;
begin
 Result:=napUserUser;
 value:=AnsiLowerCase(value);
 if Length(value)=1 then
 begin
   Result:=TNapUserLevel(StrToIntDef(value,1));
   exit;
 end;
 if AnsiLowerCase(levels[5])=value then Result:=napUserConsole;
 if AnsiLowerCase(levels[4])=value then Result:=napUserElite;
 if AnsiLowerCase(levels[3])=value then Result:=napUserAdmin;
 if AnsiLowerCase(levels[2])=value then Result:=napUserModerator;
 if AnsiLowerCase(levels[0])=value then Result:=napUserLeech;
 if Result=napUserUser then
 begin
   if AnsiLowerCase(levels[1])=value then exit;
   if value='leech' then Result:=napUserLeech;
   if value='moderator' then Result:=napUserModerator;
   if value='admin' then Result:=napUserAdmin;
   if value='administrator' then Result:=napUserAdmin;
   if value='elite' then Result:=napUserElite;
   if value='console' then Result:=napUserConsole;
 end;
end;

function GetMimeType(filename:String): TNapMimeType;
begin
 // default value.  Extensions .mp3, mp2 are not checked
 Result:=napTypeMP3;
 filename:=lowercase(ExtractFileExt(filename));
 // Audio
 if filename='.wav' then Result:=napTypeAudio;
// if filename='.wma' then Result:=napTypeAudio; // napTypeMP3
// if filename='.ogg' then Result:=napTypeAudio; // napTypeMP3
 if filename='.mid' then Result:=napTypeAudio;
 if filename='.voc' then Result:=napTypeAudio;
 if filename='.mod' then Result:=napTypeAudio;
 if filename='.ra' then Result:=napTypeAudio;
 if filename='.rmp' then Result:=napTypeAudio;
 if filename='.rm' then Result:=napTypeAudio;
 if filename='.rv' then Result:=napTypeAudio;
 // Video
 if filename='.mpeg' then Result:=napTypeVideo;
 if filename='.mpg' then Result:=napTypeVideo;
 if filename='.avi' then Result:=napTypeVideo;
 if filename='.asf' then Result:=napTypeVideo;
 if filename='.mov' then Result:=napTypeVideo;
 if filename='.fli' then Result:=napTypeVideo;
 if filename='.flc' then Result:=napTypeVideo;
 if filename='.lsf' then Result:=napTypeVideo;
 if filename='.wm' then Result:=napTypeVideo;
 if filename='.wmv' then Result:=napTypeVideo;
 if filename='.qt' then Result:=napTypeVideo;
 if filename='.viv' then Result:=napTypeVideo;
 if filename='.vivo' then Result:=napTypeVideo;
 // Text
 if filename='.txt' then Result:=napTypeText;
 if filename='.pdf' then Result:=napTypeText;
 if filename='.doc' then Result:=napTypeText;
 if filename='.wri' then Result:=napTypeText;
 // Images
 if filename='.gif' then Result:=napTypeImage;
 if filename='.png' then Result:=napTypeImage;
 if filename='.jpg' then Result:=napTypeImage;
 if filename='.jpe' then Result:=napTypeImage;
 if filename='.jpeg' then Result:=napTypeImage;
 if filename='.psd' then Result:=napTypeImage;
 if filename='.tga' then Result:=napTypeImage;
 if filename='.bmp' then Result:=napTypeImage;
 if filename='.fla' then Result:=napTypeImage;
 if filename='.swf' then Result:=napTypeImage;
 if filename='.tif' then Result:=napTypeImage;
 if filename='.tiff' then Result:=napTypeImage;
 // Applications
 if filename='.exe' then Result:=napTypeApplication;
 if filename='.zip' then Result:=napTypeApplication;
 if filename='.gz' then Result:=napTypeApplication;
 if filename='.tgz' then Result:=napTypeApplication;
 if filename='.hqx' then Result:=napTypeApplication;
 if filename='.sit' then Result:=napTypeApplication;
end;

function  TrimSpaces(str: String): String;
begin
 if length(str)>0 then
 if str[1]=#32 then
   Delete(str,1,1);
 if length(str)>0 then
 if str[Length(str)]=#32 then
   Delete(str,Length(str),1);
 if length(str)>0 then
 if str[Length(str)]=#10 then
   Delete(str,Length(str),1);
 if length(str)>0 then
 if str[Length(str)]=#13 then
   Delete(str,Length(str),1);
 Result:=str;
end;

function NextParamEx(str:String; num: Integer=1): String;
var
 c: Char;
 startpos, pos, len, count: Integer;
 quoted, start, valid: Boolean;
begin
 pos:=1;
 len:=Length(str);
 quoted:=false;
 start:=true;
 startpos:=1;
 count:=0;
 while pos<=len do
 begin
   c:=str[pos];
   case ord(c) of
     32: begin // space
           if (not start) and (not quoted) then
           begin // new string start
             inc(count);
             if count>num then
             begin
               Result:=copy(str,startpos,len-startpos+1);
               exit;
             end;
             start:=true;
             startpos:=pos+1;
           end
           else
             start:=false;
         end;
     34: begin // quote
           if quoted then
           begin // end of quote if end of string
             valid:=false;
             if len<(pos+1) then valid:=true
             else if ord(str[pos+1])=32 then valid:=true;
             if valid then // end of line
             begin
               inc(count);
               if count>num then
               begin
                 if pos=len then dec(len)
                 else if startpos>1 then dec(startpos);
                 Result:=copy(str,startpos,len-startpos+1);
                 exit;
               end;
               quoted:=false;
               start:=true;
               inc(pos);
               startpos:=pos+1;
             end;
           end
           else if start then
           begin
             quoted:=true;
             start:=true;
             startpos:=pos+1;
           end;
         end;
     else
       start:=false;
   end;
   inc(pos);
 end;
 if not start then
 if (count+1)>num then
 begin
   if quoted then
    Result:=copy(str,startpos,len-startpos)
   else
    Result:=copy(str,startpos,len-startpos+1);
   exit; 
 end;
 Result:='';
end;

{function  NextParamEx(str:String; num: Integer=1): String;
var
 j: Integer;
begin
 //j:=pos(#9,str);
 str:=TrimSpaces(str);
 if Length(str)>0 then
 if str[1]='"' then
 begin
   str:=Copy(str,2,Length(str));
   j:=pos('"',str);
   if j<1 then
   begin
     Result:='';
     exit;
   end;
   str:=TrimSpaces(Copy(str,j+1,Length(str)));
 end
 else
 begin
   j:=pos(' ',str);
   if j<1 then
   begin
     Result:='';
     exit;
   end;
   str:=TrimSpaces(copy(str,j+1,Length(str)));
 end;
 if num>1 then
  Result:=NextParamEx(str,num-1)
 else
  Result:=str;
end;}

function  JoinString(list: TMyStringList): String;
var
 str: String;
 i: Integer;
begin
 str:='';
 for i:=0 to list.Count-1 do
 begin
   if i>0 then str:=str+' ';
   if (pos(' ',list.Strings[i])>0) or (Length(list.Strings[i])<1) then
    str:=str+'"'+list.Strings[i]+'"'
   else
    str:=str+list.Strings[i];
 end;
 Result:=str;
end;

function  JoinString(hash: TStringHash): String;
var
 str: String;
 p: PStringHashItem;
begin
 str:='';
 p:=hash.first;
 while p<>nil do
 begin
   if str<>'' then str:=str+' ';
   if (pos(' ',p^.data)>0) or (Length(p^.data)<1) then
    str:=str+'"'+p^.data+'"'
   else
    str:=str+p^.data;
   p:=p^.next; 
 end;
 Result:=str;
end;

function  FirstParam(str: String): String;
var
 quotes: Boolean;
 i: Integer;
begin
 Result:='';
 str:=trim(str);
 if Length(str)<1 then exit;
 quotes:=str[1]='"';
 if quotes then
 begin
  str:=Copy(str,2,Length(str));
  if Length(str)<1 then exit;
  i:=pos('"',str);
 end
 else
  i:=pos(' ',str);
 if i<1 then Result:=str
 else Result:=Copy(str,1,i-1);
end;

function  NextParam(str:String; num: Integer=1): String;
var
 j: Integer;
begin
 //j:=pos(#9,str);
{ while j>0 do
 begin // replacing <TAB> with <SPACE>
   str[j]:=#32;
   j:=pos(#9,str);
 end;}
 str:=Trim(str);
 if length(str)=0 then str:='help';
 if str[1]='"' then
 begin
   str:=Copy(str,2,Length(str));
   j:=pos('"',str);
   if j<1 then
   begin
     Result:='';
     exit;
   end;
   str:=Trim(Copy(str,j+1,Length(str)));
 end
 else
 begin
   j:=pos(' ',str);
   if j<1 then
   begin
     Result:='';
     exit;
   end;
   str:=Trim(copy(str,j+1,Length(str)));
 end;
 if num>1 then
  Result:=NextParam(str,num-1)
 else
  Result:=str; 
end;

function SplitString(str:String; lst:TMyStringList):Integer;
var
 c: Char;
 startpos, pos, len: Integer;
 quoted, start, valid: Boolean;
begin
 lst.Clear;
 pos:=1;
 len:=Length(str);
 quoted:=false;
 start:=true;
 startpos:=1;
// lst.add('debug: startpos=1. data='+copy(str,pos,256));
 while pos<=len do
 begin
   c:=str[pos];
   case ord(c) of
     32: begin // space
//           lst.add('debug: space. pos='+IntToStr(pos)+' startpos='+IntToStr(startpos)+' quoted='+IntToStr(Ord(quoted))+' start='+IntToStr(Ord(start))+' data='+copy(str,pos,256));
           if (not start) and (not quoted) then
           begin // new string start
             lst.Add(copy(str,startpos,pos-startpos));
             start:=true;
             startpos:=pos+1;
           end
           else
             start:=false;
         end;
     34: begin // quote
//           lst.add('debug: quote. pos='+IntToStr(pos)+' startpos='+IntToStr(startpos)+' quoted='+IntToStr(Ord(quoted))+' start='+IntToStr(Ord(start))+' data='+copy(str,pos,256));
           if quoted then
           begin // end of quote if end of string
             valid:=false;
             if len<(pos+1) then valid:=true
             else if ord(str[pos+1])=32 then valid:=true;
             if valid then // end of line
             begin
               lst.Add(copy(str,startpos,pos-startpos));
               quoted:=false;
               start:=true;
               inc(pos);
               startpos:=pos+1;
             end;
           end
           else if start then
           begin
             quoted:=true;
             start:=true;
             startpos:=pos+1;
           end;
         end;
     else
       start:=false;
   end;
   inc(pos);
 end;
// lst.add('debug: end. pos='+IntToStr(pos)+' startpos='+IntToStr(startpos)+' quoted='+IntToStr(Ord(quoted))+' start='+IntToStr(Ord(start)));
 if not start then
 begin
   if quoted then
    lst.Add(copy(str,startpos,len-startpos))
   else
    lst.Add(copy(str,startpos,len-startpos+1));
 end
 else if start and quoted then
   lst.Add('');
// lst.Add('debug: end.');
 Result:=lst.count;
end;

function SplitStringOld(str:String; lst:TMyStringList):Integer;
var
 c:Char;
 str1,str2:String;
 j,num,max:Integer;
 b:Boolean;
begin
 lst.Clear;
 str1:='';
 str2:=Trim(str);
 if str2='' then
 begin
  Result:=0;
  exit;
 end;
{ j:=pos(#9,str2);
 while j>0 do
 begin // replacing <TAB> with <SPACE>
   str2[j]:=#32;
   j:=pos(#9,str2);
 end;}
 max:=Length(str)+128;
 num:=0;
 j:=0;
 b:=false; // makes compiler happy
 repeat
  if Length(str2)>0 then
  begin
   b:=false;
   str2:=Trim(str2);
   j:=pos(' ',str2);
   c:=str2[1];
   if c='"' then
   begin
    j:=Pos('"',Copy(str2,2,max))+2;
    b:=true;
   end;
   if j=0 then j:=Length(str2)
   else
   begin
    str:=Trim(Copy(str2,1,j));
    if str[1]='"' then
     if str[Length(str)]='"' then
      str:=Copy(str,2,Length(str)-2);
    lst.Add(str);
    str2:=Trim(Copy(str2,j,max));
    inc(num);
    j:=0;
   end;
  end else break;
 until j=Length(str2);
 if not b then
  lst.Add(Trim(str2));
 Result:=num+1;
end;

function  SplitString(str:String; var hash:TStringHash):Integer; overload;
var
 c:Char;
 str1,str2:String;
 j,num,max:Integer;
 b:Boolean;
begin
 StrHash_Clear(hash);
 str1:='';
 str2:=Trim(str);
 if str2='' then
 begin
  Result:=0;
  exit;
 end;
 max:=Length(str)+128;
 num:=0;
 j:=0;
 b:=false; // makes compiler happy
 repeat
  if Length(str2)>0 then
  begin
   b:=false;
   str2:=Trim(str2);
   j:=pos(' ',str2);
   c:=str2[1];
   if c='"' then
   begin
    j:=Pos('"',Copy(str2,2,max))+2;
    b:=true;
   end;
   if j=0 then j:=Length(str2)
   else
   begin
    str:=Trim(Copy(str2,1,j));
    if str[1]='"' then
     if str[Length(str)]='"' then
      str:=Copy(str,2,Length(str)-2);
    StrHash_AddEx(hash,str);
    str2:=Trim(Copy(str2,j,max));
    inc(num);
    j:=0;
   end;
  end else break;
 until j=Length(str2);
 if not b then
  StrHash_AddEx(hash,Trim(str2));
 Result:=num+1;
end;


function  compare(cmp: TNapCompare; et: Integer; src: Integer): Boolean;
begin
 case cmp of
   napAtLeast:   Result:=src>=et;
   napEqual:     Result:=src=et;
   napAtBest:    Result:=src<=et;
   else Result:=true;
 end;
end;

function decode_ip(Value: Cardinal):String;
var
 str:String;
 i: Cardinal;
 j: Cardinal;
 c: Array[0..3] of Byte;
begin
 for i:=0 to 3 do
 begin
  j:=(Value and (256 shl (i*8) - 1));
  if i<>0 then
   j:=j div (1 shl (i*8));
  c[i]:=j;
 end;
 str:='';
 for i:=0 to 3 do
 begin
  str:=str+IntToStr(c[i]);
  if i<>3 then str:=str+'.';
 end;
 Result:=str;
end;

function  decode_ip(Value: String):String; overload;
begin
 Result:=decode_ip(Cardinal(StrToInt64(Value)));
end;

function  encode_ip_str(str:String):String;
var
 num: Array[0..3]of Int64;
 list: TMyStringList;
 i:Integer;
 n: Int64;
begin
 Result:='0';
 i:=pos('.',str);
 while i<>0 do
 begin
   str[i]:=' ';
   i:=pos('.',str);
 end;
 list:=CreateStringList;
 SplitString(str,list);
 if list.Count<4 then exit; // error
 for i:=0 to 3 do
  num[i]:=StrToInt64Def(list.Strings[i],0);
 FreeStringList(list);
 n:=((num[3]*256+num[2])*256+num[1])*256+num[0];
 Result:=IntToStr(n);
end;

function  encode_ip(str:String):LongWord;
var
 num: Array[0..3]of LongWord;
 list: TMyStringList;
 i: Integer;
 n: LongWord;
begin
 Result:=0;
 i:=pos('.',str);
 while i<>0 do
 begin
   str[i]:=' ';
   i:=pos('.',str);
 end;
 list:=CreateStringList;
 SplitString(str,list);
 if list.Count<4 then exit; // error
 for i:=0 to 3 do
  num[i]:=StrToInt64Def(list.Strings[i],0);
 FreeStringList(list);
 n:=((num[3]*256+num[2])*256+num[1])*256+num[0];
 Result:=n;
end;

function  encode_ip_rev(str:String):String; 
var 
 num: Array[0..3]of Int64; 
 i, j: Integer; 
 n: Int64; 
 data: Array[0..15] of String; 
begin 
 Result:='0'; 
 i:=pos('.',str); 
 j:=0; 
 while i<>0 do 
 begin 
   data[j]:=Copy(str,1,i-1); 
   str:=Copy(str,i+1,64); 
   i:=pos('.',str); 
   inc(j); 
 end; 
 for i:=0 to 3 do 
  num[i]:=StrToInt64Def(data[i],0); 
 n:=((num[0]*256+num[1])*256+num[2])*256+num[3]; 
 Result:=IntToStr(n); 
end; 

function  index_ip(ip: Cardinal): Integer;
begin
  Result:=(ip shr 12) and 1023;
end;

function  UnixTimeToDateTime(time: time_t): TDateTime;
var
 t: TTimeZoneInformation;
 i: TDateTime;
 day: Integer;
 hour,min,sec: Word;
begin
 GetTimeZoneInformation(t);
 time:=time-t.bias*60; // GMT -> local time
 sec:=time mod 60;
 min:=(time div 60) mod 60;
 hour:=(time div 3600) mod 24;
 day:=time div 86400;
 i:=EncodeTime(hour,min,sec,0);
 i:=i+day+25569;
 Result:=i;
end;

function  DateTimeToUnixTime(time: TDateTime): time_t;
// converts TDateTime to C/C++ time_t (time - local time, result - GMT)
var
 t: TTimeZoneInformation;
 i: time_t;
 h,m,s,x:Word;
 n: Integer;
begin
 GetTimeZoneInformation(t);
 i:=Trunc(time)-25569;
 DecodeTime(time,h,m,s,x);
 n:=m+t.bias;
 i:=s+60*(n+60*(h+24*i));
 Result:=i;
end;

function  UnixTimetoStr(t: time_t): String;
begin
 Result:=DateTimeToStr(UnixTimeToDateTime(t));
end;

function  StrToUnixTime(str: String): time_t;
begin
 Result:=DateTimeToUnixTime(StrToDateTime(str));
end;

function  StrToUnixTimeDef(str: String; def: time_t): time_t;
begin
 try
  Result:=StrToUnixTime(str)
  except
   Result:=def;
 end;
end;

function  GetTickCountT: time_t;
begin
 Result:=DateTimeToUnixTime(now);
end;

function FileSize(const FileName: string): Integer;
var
  Handle: THandle;
  FindData: TWin32FindData;
begin
  Result := -1;
  Handle := FindFirstFile(PChar(FileName), FindData);
  if Handle <> INVALID_HANDLE_VALUE then
  begin
    Windows.FindClose(Handle);
    if (FindData.dwFileAttributes and FILE_ATTRIBUTE_DIRECTORY) = 0 then
     Result:=(FindData.nFileSizeHigh * MAXDWORD) + FindData.nFileSizeLow;
  end;
end;

function  NapCmd(id: Integer; cmd: String): TNapCmd;
var
 a: TNapCmd;
begin
 a.id:=id;
 a.cmd:=cmd;
 Result:=a;
end;

function  NapDoubleCmd(id1,id2: Integer;cmd1,cmd2: String): TNapDoubleCmd;
var
 a: TNapDoubleCmd;
begin
 a.id1:=id1;
 a.id2:=id2;
 a.cmd1:=cmd1;
 a.cmd2:=cmd2;
 Result:=a;
end;

function  NapCmdEx(id: Integer; cmd: String; data: String): TNapCmdEx;
var
 t:TNapCmdEx;
begin
 t.id:=id;
 t.cmd:=cmd;
 t.data:=data;
 Result:=t;
end;

function IPisLocal(str: String): Boolean;
begin
 Result:=false;
 if (copy(str,1,4)='127.') or (copy(str,1,3)='10.') or (copy(str,1,8)='192.168.') then
  Result:=true;
end;

function  isDigit(str: String): Boolean;
var
 i: Integer;
begin
 Result:=false;
 for i:=1 to Length(str) do
  if not (str[i] in ['0'..'9']) then exit;
 Result:=true;
end;

function  GetDigit(str: String): String;
var
 str1: String;
 i: Integer;
begin
 str1:='';
 for i:=1 to Length(str) do
 begin
  if isDigit(str[i]) then
   str1:=str1+str[i]
  else
  begin
    Result:=str1;
    exit;
  end;
 end;
 Result:=str1;
end;

function GetLogTime: String;
begin
 Result:='['+TimeToStr(now)+']: ';
end;

function  IntToStrDot(Value: Integer): String; overload;
var
 str,str1: String;
 i: Integer;
begin
 str:=IntToStr(Value);
 str1:='';
 while Length(str)>3 do
 begin
   i:=Length(str)-2;
   str1:='.'+Copy(str,i,3)+str1;
   str:=Copy(str,1,i-1);
 end;
 str1:=str+str1;
 Result:=str1;
end;

function  IntToStrDot(Value: Int64): String; overload;
var
 str,str1: String;
 i: Integer;
begin
 str:=IntToStr(Value);
 str1:='';
 while Length(str)>3 do
 begin
   i:=Length(str)-2;
   str1:='.'+Copy(str,i,3)+str1;
   str:=Copy(str,1,i-1);
 end;
 str1:=str+str1;
 Result:=str1;
end;

procedure ReplaceString(var source: String;old,new: String);
var
 Offset: Integer;
 NewStr: string;
begin
 NewStr := source;
 source := '';
 while NewStr <> '' do
 begin
   Offset := AnsiPos(old, NewStr);
   if Offset = 0 then
   begin
     source := source + NewStr;
     Break;
   end;
   source := source + Copy(NewStr, 1, Offset - 1) + new;
   NewStr := Copy(NewStr, Offset + Length(old), MaxInt);
 end;
end;

function StripString(str: String;minus: Boolean=false): String;
var
 i: Integer;
begin
 if not minus then
  for i:=1 to Length(str) do
   if not ((str[i] in ['A'..'Z','a'..'z','0'..'9']) or (Ord(str[i])>127)) then
    str[i]:=#32;
 if minus then
  for i:=1 to Length(str) do
  begin
   if not ((str[i] in ['A'..'Z','a'..'z','0'..'9']) or (Ord(str[i])>127)) then
    if str[i]='-' then
    begin
      if i>1 then
       if str[i-1]<>' ' then
        str[i]:=#32;
    end
    else str[i]:=#32;
  end;
 Result:=str;
end;

function  MatchesList(list: TMyStringList; str: String): Integer;
var
 i: Integer;
begin
 Result:=-1;
 if list=nil then exit;
 for i:=0 to list.Count-1 do
  if MatchesMaskEx(str,list.Strings[i]) then
  begin
    Result:=i;
    exit;
  end;
end;

function  encode(src:String; complete: Boolean=true):String;
var
 str: String;
 i: Integer;
begin
 // this is a simple function. this protection works only agains complete fools.
 // i switched to this function from usual MD5 because some admins tried to
 // decode passwords using tools that allows to crack md5-based passwords.
 if complete then
  str:=lowercase(StrMD5(src))
 else
  str:=src;
 i:=((Ord(str[1]) xor 10) mod 10)+15;  
 str:=Copy(lowercase(StrMd5('pass-'+Copy(StrMD5('pass-'+str),1,i))),1,i);
 for i:=1 to Length(str) do
  if str[i] in ['0'..'9'] then str[i]:=Char(Ord(str[i])-48+103);
 for i:=1 to Length(src) do
  src[i]:=#0;
 Result:=str;  
end;

function  null_pass: String;
begin
 Result:=encode('');
end;

function check_name(str:String; ignore: Boolean=false):Boolean;
var
 i:Integer;
begin
 Result:=false;
 if Length(str)<min_user_name then exit;
 if Length(str)>max_user_name then exit;
 str:=AnsiLowerCase(str);
 // reserved names
 if str='operserv' then exit;
 if str='chanserv' then exit;
 if str='operator' then exit;
 if str='nickserv' then exit;
 if str='msgserv'  then exit;
 if str=AnsiLowerCase(loginimbot) then exit;
 if not ignore then
 begin
   if str='leech'    then exit;
   if str='user'     then exit;
   if str='moderator' then exit;
   if str='admin'    then exit;
   if str='administrator' then exit;
   if str='elite'    then exit;
   if str='server'   then exit;
   if str='channel'  then exit;
   if str='root'     then exit;
   for i:=0 to 4 do if str=AnsiLowerCase(levels[i]) then exit;
 end;
 if allow_2bytename then
 begin
   if AnsiPos('　', str) > 0 then Exit;
   if Pos('{\rtf', str) > 0 then Exit;
   for i:=1 to Length(str) do
     if (str[i]<='!') or (str[i]='.') or (str[i]=#127) then exit;
 end
 else
   for i:=1 to Length(str) do
    if not (str[i] in ['a'..'z','A'..'Z','0'..'9','_','[',']','{','}','-','@','^','$']) then exit;
 result:=true;
end;

function  check_software(str: String): Boolean;
var
 i: Integer;
begin
 Result:=false;
 str:=trim(str);
 if Length(str)<3 then exit;
 for i:=1 to Length(str) do
  if not (str[i] in ['a'..'z','A'..'Z','0'..'9','-','_','.','+',' ','[',']','(',')','{','}']) then
    exit;
 if lowercase(trim(str))='slavanap console' then exit;
 Result:=true;
end;

function check_port(port: Integer): Boolean;
var
  p: PStringHashItem;
begin
  Result:=False;
  if not block_transferport then
  begin
    Result:=True;
    exit;
  end;
  p:=blocked_transferport_list.first;
  while p<>nil do
  begin
    if port=StrToIntDef(p^.data,-1) then exit;
    p:=p^.next;
  end;
  Result:=True;
end;

function  channelname(str: String):String;
var
 i: Integer;
begin
 Result:='';
 str:=Trim(str);
 if Length(str)>max_channel_name then str:='';
 if Length(str)<1 then exit;
 if str[1]<>'#' then
  if not (str[1] in ['0'..'9','A'..'Z','a'..'z']) then
   str:='#'+str;
 i:=pos('"',str);
 while i>0 do
 begin
  Delete(str,i,1);
  i:=pos('"',str);
 end;
 if allow_2bytename then
 begin
   for i:=Length(str) downto 1 do
     if str[i]<=' ' then
       Delete(str,i,1);
 end
 else
   for i:=Length(str) downto 1 do
     if (Ord(str[i])<33) or (Ord(str[i])>122) then
       Delete(str,i,1);
 if Length(str)>32 then str:=Copy(str,1,32);
 if pos('#',Copy(str,2,max_channel_name))>0 then exit;
 //if str='#' then str:='';
 //if channels_irc then
 // if Length(str)>0 then
 //  if str[1]<>'#' then str:='#'+str;
 if channels_low then str:=AnsiLowerCase(str);
 Result:=str;
end;

function  GetIndex(list: TMyStringList; str: String; ignore_case: Boolean): Integer;
var
 i: Integer;
begin
 Result:=-1;
 if list=nil then exit;
 if ignore_case then str:=AnsiLowerCase(str);
 if ignore_case then
 for i:=0 to list.Count-1 do
  if AnsiLowerCase(list.Strings[i])=str then
  begin
    Result:=i;
    exit;
  end;
 if not ignore_case then
 for i:=0 to list.Count-1 do
  if list.Strings[i]=str then
  begin
    Result:=i;
    exit;
  end;
end;

procedure check_name_key(var Key: Char);
begin
 if not (Key in ['a'..'z','A'..'Z','0'..'9','_','[',']','{','}','-','@','^','$']) then
 begin
  if Key>=#32 then Key:=#0;
  if Key=#13 then Key:=#0;
 end;
end;

function min(a,b: Integer): Integer;
begin
 if a>b then Result:=b
 else Result:=a;
end;

function min(a,b: Int64): Int64;
begin
 if a>b then Result:=b
 else Result:=a;
end;

function max(a,b: Integer): Integer;
begin
 if a<b then Result:=b
 else Result:=a;
end;

function max(a,b: Int64): Int64;
begin
 if a<b then Result:=b
 else Result:=a;
end;

function  HexData(str: String): String;
var
 b: Boolean;
 str1: String;
 i,j: Integer;
begin
 b:=false;
 for i:=1 to Length(str) do
  if (Ord(str[i])<32) or (Ord(str[i])>126) then b:=true;
 if not b then
 begin
   Result:=str;
   exit;
 end;
 str1:='hex:';
 for i:=1 to Length(str) do
 begin
   j:=Ord(str[i]);
   str1:=str1+IntToHex(j,2);
 end;
 Result:=str1+' ';
end;

function  HexData2(str: String): String;
var
 b: Boolean;
 str1: String;
 i,j: Integer;
begin
 b:=false;
 for i:=1 to Length(str) do
  if (Ord(str[i])<32) or (Ord(str[i])>126) then b:=true;
 if not b then
 begin
   Result:=str;
   exit;
 end;
 str1:='hex:';
 for i:=1 to Length(str) do
 begin
   j:=Ord(str[i]);
   str1:=str1+IntToHex(j,2)+' ';
   if str[i] in [#32..#126] then
    str1:=str1+#39+str[i]+#39' ';
 end;
 Result:=str1+' ';
end;

function Hex2Str(str: String): String;
var
 str1,str2: String;
 i,j: Integer;
begin
  if Copy(str,1,4)<>'hex:' then
  begin
    Result:=str;
    exit;
  end;
  str:=Copy(str,5,Length(str)-4);
  str1:='';
  str2:='$  ';
  for i:=0 to (Length(str)-1) div 2 do
  begin
   str2[2]:=str[i*2+1];
   str2[3]:=str[i*2+2];
   j:=StrToInt(str2);
   str1:=str1+Chr(j);
  end;
  Result:=str1;
end;

function  Str2Bool(str: String; def: Boolean): Boolean;
begin
 str:=trim(lowercase(str));
 Result:=true;
 if (str='1') or (str='"1"') then exit;
 if (str='on') or (str='"on"') then exit;
 if (str='true') or (str='"true"') then exit;
 Result:=false;
 if (str='0') or (str='"0"') then exit;
 if (str='off') or (str='"off"') then exit;
 if (str='false') or (str='"false"') then exit;
 Result:=def;
end;

function CountColor(c1,c2: TColor; n1,n2: Integer): TColor;
var
 r1,r2,g1,g2,b1,b2,r,g,b,n: Integer;
begin
 if c1>$00FFFFFF then c1:=GetSysColor(c1);
 if c1>$00FFFFFF then c2:=GetSysColor(c2);
 r1:=c1 and 255;
 r2:=c2 and 255;
 g1:=(c1 div 256) and 255;
 g2:=(c2 div 256) and 255;
 b1:=(c1 div 65536) and 255;
 b2:=(c2 div 65536) and 255;
 n:=n1+n2;
 r:=(r1*n1+r2*n2) div n;
 g:=(g1*n1+g2*n2) div n;
 b:=(b1*n1+b2*n2) div n;
 if r<0 then r:=0;
 if g<0 then g:=0;
 if b<0 then b:=0;
 if r>255 then r:=255;
 if g>255 then g:=255;
 if b>255 then b:=255;
 Result:=RGB(r,g,b);
end;

function GetRealString(text:String):String;
var
 str,str1,str2:String;
 i:Integer;
begin
 str:='';
 str2:='';
 str1:=text;
 i:=Pos('&',str1);
 while i<>0 do
 begin
   str:=Copy(str1,1,i-1);
   str2:=str2+str;
   str1:=Copy(str1,i+1,255);
   if Length(str1)>0 then
    if str1[1]='&' then
    begin
     str2:=str2+'&';
     str1:=Copy(str1,2,255);
    end;
   i:=Pos('&',str1);
 end;
 str2:=str2+str1;
 GetRealString:=str2;
end;

procedure SlavaDrawText(Canvas:TCanvas;text:String;p:TPoint;color1,color2,color3: TColor);
var
 str,str1:String;
 i,j:Integer;
 b:Boolean;
begin
 str:='';
 Canvas.Brush.Style:=bsClear;
 str1:=text;
 j:=0;
 i:=Pos('&',str1);
 while i<>0 do
 begin
   str:=str+Copy(str1,1,i-1);
   str1:=Copy(str1,i+1,255);
   b:=True;
   if Length(str1)>0 then
    if str1[1]='&' then
    begin
      str:=str+'&';
      str1:=Copy(str1,2,255);
      b:=False;
    end;
   if b then
   begin
     Canvas.Font.Color:=color1;
     Canvas.Font.Style:=Canvas.Font.Style - [fsUnderline];
     Canvas.TextOut(p.x+j,p.y,str);
     inc(j,Canvas.Textwidth(str));
     str:='';
     if Length(str1)>0 then
     begin
      Canvas.Font.Style:=Canvas.Font.Style + [fsUnderline];
      Canvas.Font.Color:=color2;
      Canvas.TextOut(p.x+j,p.y,str1[1]);
      Canvas.Font.Style:=Canvas.Font.Style - [fsUnderline];
      Canvas.Font.Color:=color3;
      Canvas.TextOut(p.x+j,p.y,str1[1]);
      inc(j,Canvas.TextWidth(str1[1]));
      str1:=copy(str1,2,255);
     end;
     Canvas.Font.Color:=color1;
   end;
   i:=Pos('&',str1);
 end;
 Canvas.Font.Color:=color1;
 Canvas.TextOut(p.x+j,p.y,str1);
 Canvas.Brush.Style:=bsSolid;
end;

procedure GradientFill(DC : HDC; R : TRect; StartColor, EndColor : TColor; Steps : integer; Vertical : boolean);
var // this procedure is taken from unit "ElVCLUtils" from freeware package "ElTree Lite"
  i : integer;
  RBeg, RDif, Rc,
    GBeg, GDif, Gc,
    BBeg, BDif, Bc : integer;
  Brush, OldBrush : HBrush;
  R1 : TRect;
begin
  if StartColor = EndColor then
  begin
    Brush := CreateSolidBrush(ColorToRGB(StartColor));
    FillRect(DC, R, Brush);
    DeleteObject(Brush);
  end
  else
  begin
    RBeg := GetRValue(ColorToRGB(StartColor));
    GBeg := GetGValue(ColorToRGB(StartColor));
    BBeg := GetBValue(ColorToRGB(StartColor));
    RDif := GetRValue(ColorToRGB(EndColor)) - RBeg;
    GDif := GetGValue(ColorToRGB(EndColor)) - GBeg;
    BDif := GetBValue(ColorToRGB(EndColor)) - BBeg;
    R1 := R;
    for i := 0 to Steps - 1 do // Iterate
    begin
      if Vertical then
      begin
        R1.Top := R.Top + MulDiv(i, R.Bottom - R.Top, Steps);
        R1.Bottom := R.Top + MulDiv(i + 1, R.Bottom - R.Top, Steps);
      end else
      begin
        R1.Left := R.Left + MulDiv(i, R.Right - R.Left, Steps);
        R1.Right := R.Left + MulDiv(i + 1, R.Right - R.Left, Steps);
      end;

      Rc := RBeg + MulDiv(i, RDif, Steps - 1);
      Gc := GBeg + MulDiv(i, GDif, Steps - 1);
      Bc := BBeg + MulDiv(i, BDif, Steps - 1);

      Brush := CreateSolidBrush(RGB(Rc, Gc, Bc));
      OldBrush := SelectObject(DC, Brush);
      PatBlt(DC, R1.Left, R1.Top, R1.Right - R1.Left, R1.Bottom - R1.Top, PATCOPY);
      SelectObject(DC, OldBrush);
      DeleteObject(Brush);
    end; // for
  end;
end;

function AddStr(str: String): String;
begin
 Result:=str;
 if pos(' ',str)>0 then Result:='"'+str+'"';
 if Trim(str)='' then Result:='""';
end;

function  SocketError(i: Integer):String;
begin
 Result:='socket error '+IntToStr(i)+' : '+GetErrorDesc(i);
end;

procedure Log(id: Integer; cmd: String; file_only: Boolean=false);
var
 logfilename: String;
begin
 if running or file_only then
 try
   cmd:=GetLogTime+cmd;
   if not file_only then
    if sync_reply_list<>nil then
     sync_reply_list.AddDoubleCmd(MSG_SR_LOG,id,'',cmd);
   if log_file=nil then exit;
   if not log_to_file then exit;
   cmd:=cmd+#13#10;
   ShortDateFormat := 'yyyymmdd';
   //logfilename:=ApplicationDir+'server-'+DateToStr(now)+'.log';
   logfilename:=log_folder+'server-'+DateToStr(now)+'.log';
   ShortDateFormat := 'yyyy/mm/dd';
   if not FileExists(logfilename) then begin
    try
     log_file.Free;
     log_file:=TFileStream.Create(logfilename,fmCreate);
     log_file.Free;
     except
    end;
    log_file:=nil;
    try
     log_file:=TFileStream.Create(logfilename,fmOpenWrite or fmShareDenyWrite);
     except
      log_file:=nil;
      DebugLog('Error: cannot open file '+logfilename);
    end;
   end;
   log_file.Write(cmd[1],Length(cmd));
  except
 end;
end;

procedure DebugLog(cmd: String; file_only: Boolean=false);
begin
 if running or file_only then
 try
   if not log_to_file then exit;
   if not file_only then Log(slDebugData,cmd,false);
   if debug_file=nil then exit;
   cmd := GetLogTime + cmd + #13#10;
   debug_file.Write(cmd[1],Length(cmd));
  except
 end;
end;

procedure LogConsole(id: Integer; cmd: String);
var
 str,logfilename: String;
begin
 if not running then exit;
 try
   str:=GetLogTime+cmd;
   sync_reply_list.AddDoubleCmd(MSG_SR_CONSOLELOG,id,'',str);
   if log_file=nil then exit;
   cmd:=GetLogTime+'Console: '+cmd+#13#10;
   if log_to_file then begin
    ShortDateFormat := 'yyyymmdd';
    //logfilename:=ApplicationDir+'server-'+DateToStr(now)+'.log';
    logfilename:=log_folder+'server-'+DateToStr(now)+'.log';
    ShortDateFormat := 'yyyy/mm/dd';
    if not FileExists(logfilename) then begin
     try
      log_file.Free;
      log_file:=TFileStream.Create(logfilename,fmCreate);
      log_file.Free;
      except
     end;
     log_file:=nil;
     try
      log_file:=TFileStream.Create(logfilename,fmOpenWrite or fmShareDenyWrite);
      except
       log_file:=nil;
       DebugLog('Error: cannot open file '+logfilename);
     end;
    end;
    log_file.Write(cmd[1],Length(cmd));
   end;
  except
 end;  
end;

function  GetSoftware(str: String): Integer;
var
 i: Integer;
begin
 str:=AnsiLowerCase(str);
 for i:=1 to Length(str) do
 begin
  if Ord(str[i])<32 then str[i]:=#32;
  if Ord(str[i])>127 then str[i]:=#32;
 end;
 str:=trim(str);
 if Copy(str,1,9)='v2.0 beta' then Result:=softNapster
 else if str='audiognome' then Result:=softAudioGnome
 else if (Copy(str,1,5)='winmx') AND (pos('j',str)>0) then Result:=softWinMXJap
 else if Copy(str,1,5)='winmx' then Result:=softWinMXNormal
 else if copy(str,1,8)='trippymx' then Result:=softWinMXNormal
 else if str='gnomeplus+' then Result:=softGnomePlus
 else if Copy(str,1,6)='teknap' then Result:=softTekNap
 else if str='dagsta' then Result:=softDagsta
 else if Copy(str,1,9)='floodster' then Result:=softFloodster
 else if Copy(str,1,6)='amster' then Result:=softAmster
 else if Copy(str,1,13)='filenavigator' then Result:=softFileNavigator
 else if Copy(str,1,9)='rapigator' then Result:=softRapigator
 else if Copy(str,1,7)='swaptor' then Result:=softSwaptor
 else if Copy(str,1,5)='cq_ex' then Result:=softCQEX
 else if Copy(str,1,10)='sunshineun' then Result:=softSunshineUN
 else if Copy(str,1,8)='nap v0.8' then Result:=softNap08
 else if Copy(str,1,9)='napigator' then Result:=softNapigator
 else if Copy(str,1,4)='nap ' then Result:=softNap
 else if Copy(str,1,6)='macnap' then Result:=softMacNap
 else if Copy(str,1,8)='mp3 rage' then Result:=softMP3Rage
 else if Copy(str,1,4)='xnap' then Result:=softXNap
 else if Copy(str,1,9)='spotlight' then Result:=softSpotlight
 else if Copy(str,1,3)='nfs' then Result:=softNFS
 else if Copy(str,1,9)='dmnapster' then Result:=softDMNapster
 else if Copy(str,1,8)='knapster' then Result:=softKnapster
 else if Copy(str,1,7)='lopster' then Result:=softLopster
 else if Copy(str,1,8)='drumbeat' then Result:=softDrumbeat
 else if Copy(str,1,8)='mldonkey' then Result:=softMlDonkey
 else if Copy(str,1,7)='opennap' then Result:=softOpennap
 else if Copy(str,1,7)='napchan' then Result:=softNapchan
 else if Copy(str,1,7)='utatane' then Result:=softUtatane
 else if Copy(str,1,4)='2get'    then Result:=soft2get
 else if Copy(str,1,4)='Regnessem' then Result:=softRegnessem
 else Result:=softUnknown;
end;

{function MatchesMaskEx(s,mask:string):Boolean;
var
 i,mi:integer;
begin
  // taken from post by Timur Shemsedinov (Timur.Shemsedinov@p88.f482.n463.z2.fidonet.org) in news://ddt.demos.su/fido7.ru.delphi
  Result:=true; i:=0; mi:=0;
  while (Result)and(not((i>length(s))and(mi>length(mask))))and
        (not((mi=length(mask))and(mask[mi]='*')))
  do begin
    if i=length(s) then begin
      while mask[mi]='*' do Inc(mi);
      Result:=mi>length(mask); exit;
    end;
    Result:=mi<=length(mask);
    if not Result then exit;
    if mask[mi]='*' then begin;
      Inc(mi);
      while i>length(s) do begin
        Result:=MatchesMaskEx(Copy(s,i,length(s)-i+1),
                            Copy(mask,mi,length(mask)-mi+1));
        if not Result then Inc(i) else exit;
      end; exit;
    end else begin;
      if mask[mi]<>'?' then begin
        Result:=s[i]=mask[mi];
        if not Result then exit;
      end;
      Inc(i); Inc(mi);
    end;
  end;
end;}

function MatchesMaskEx(s,mask:string):Boolean;
begin
 try
  Result:=MatchesMaskS(s,mask)
  except
  Result:=s=mask;
 end;
end;

function CanReceive(server: Boolean): Boolean;
begin
 Result:=true;
 if bandwidth_maxdown=0 then exit;
 if (not server) or bandwidth_limitservers then
  Result:=bandwidth_down<bandwidth_alloweddown;
 inc(bandwidth_checkcount);
 if bandwidth_checkcount>=BANDWIDTH_CYCLE then CheckBandwidthTime;
end;

function CanSend(server: Boolean): Boolean;
begin
 Result:=true;
 if bandwidth_maxup=0 then exit;
 if (not server) or bandwidth_limitservers then
  Result:=bandwidth_up<bandwidth_allowedup;
 inc(bandwidth_checkcount);
 if bandwidth_checkcount>=BANDWIDTH_CYCLE then CheckBandwidthTime;
end;

procedure CheckBandwidthTime;
var
 t: Cardinal;
 a: Integer;
begin
 t:=GetTickCount;
 if bandwidth_checkcount>=BANDWIDTH_CYCLE then dec(bandwidth_checkcount,BANDWIDTH_CYCLE);
 if (t-bandwidth_lastcheck)>BANDWIDTH_TIMEOUT then
 begin
   inc(bandwidth_lastcheck,BANDWIDTH_TIMEOUT);
   bandwidth_limited:=false;
   bandwidth_up:=0;
   bandwidth_down:=0;
   bandwidth_allowedup:=0;
   bandwidth_alloweddown:=0;
   exit;
 end;
 if bandwidth_maxup>0 then
 begin
   bandwidth_allowedup:=(t-bandwidth_lastcheck)*bandwidth_maxup div 1000;
   a:=bandwidth_up*3 div 2;
   if a>bandwidth_allowedup then bandwidth_limited:=true;
 end;
 if bandwidth_maxdown>0 then
 begin
   bandwidth_alloweddown:=(t-bandwidth_lastcheck)*bandwidth_maxdown div 1000;
   a:=bandwidth_down*3 div 2;
   if a>bandwidth_alloweddown then bandwidth_limited:=true;
 end;
end;

function SetSocketCloseTime: Cardinal;
begin
 Result:=GetTickCount-timeout_login+2000; // 2 seconds timeout
end;

function  UserState2Int(state: TUserState): Integer;
var
 i: Integer;
begin
  i:=0;
  if userMuzzled in state then inc(i,1);
  // skip userChatting
  if userHideErrors in state then inc(i,2);
  if userHideAnnouncements in state then inc(i,4);
  if userCloaked in state then inc(i,8);
  if userHideMBans in state then inc(i,16);
  if userHideMBanConn in state then inc(i,32);
  if userHideSBans in state then inc(i,64);
  if userHideSBanConn in state then inc(i,128);
  if userHideChange in state then inc(i,256);
  if userHideKill in state then inc(i,512);
  if userHideLevel in state then inc(i,1024);
  if userHideServer in state then inc(i,2048);
  if userHideMuzzle in state then inc(i,4096);
  if userHidePort in state then inc(i,8192);
  if userHideWallop in state then inc(i,16384);
  if userHideCloak in state then inc(i,32768);
  if userHideFlood in state then inc(i,65536);
  if userHidePM in state then inc(i,131072);
  if userHideWhois in state then inc(i,262144);
  if userHideFriends in state then inc(i,524288);
  if userHideChannel in state then inc(i,1048576);
  if userHideRegister in state then inc(i,2097152);
  if userHideVar in state then inc(i,2097152*2);
  if userHideBrowse in state then inc(i,2097152*4);
  if userHideMotd in state then inc(i,2097152*8);
  if userHidePing in state then inc(i,2097152*16);
  if userHideLeech in state then inc(i,2097152*32);
  if userHideSameNic in state then inc(i,2097152*64);
  Result:=i;
end;

function  Int2UserState(n: Integer; chatting: Boolean): TUserState;
var
 st: TUserState;
begin
  st:=[];
  if chatting then st:=[userChatting];
  if (n and 1)<>0 then st:=st+[userMuzzled];
  if (n and 2)<>0 then st:=st+[userHideErrors];
  if (n and 4)<>0 then st:=st+[userHideAnnouncements];
  if (n and 8)<>0 then st:=st+[userCloaked];
  if (n and 16)<>0 then st:=st+[userHideMBans];
  if (n and 32)<>0 then st:=st+[userHideMBanConn];
  if (n and 64)<>0 then st:=st+[userHideSBans];
  if (n and 128)<>0 then st:=st+[userHideSBanConn];
  if (n and 256)<>0 then st:=st+[userHideChange];
  if (n and 512)<>0 then st:=st+[userHideKill];
  if (n and 1024)<>0 then st:=st+[userHideLevel];
  if (n and 2048)<>0 then st:=st+[userHideServer];
  if (n and 4096)<>0 then st:=st+[userHideMuzzle];
  if (n and 8192)<>0 then st:=st+[userHidePort];
  if (n and 16384)<>0 then st:=st+[userHideWallop];
  if (n and 32768)<>0 then st:=st+[userHideCloak];
  if (n and 65536)<>0 then st:=st+[userHideFlood];
  if (n and 131072)<>0 then st:=st+[userHidePM];
  if (n and 262144)<>0 then st:=st+[userHideWhois];
  if (n and 524288)<>0 then st:=st+[userHideFriends];
  if (n and 1048576)<>0 then st:=st+[userHideChannel];
  if (n and 2097152)<>0 then st:=st+[userHideRegister];
  if (n and (2097152*2))<>0 then st:=st+[userHideVar];
  if (n and (2097152*4))<>0 then st:=st+[userHideBrowse];
  if (n and (2097152*8))<>0 then st:=st+[userHideMotd];
  if (n and (2097152*16))<>0 then st:=st+[userHidePing];
  if (n and (2097152*32))<>0 then st:=st+[userHideLeech];
  if (n and (2097152*64))<>0 then st:=st+[userHideSameNic];
  Result:=st;
end;


{function  UserState2Int(state: TUserState): Integer;
var
 i: Integer;
begin
  i:=0;
  if userMuzzled in state then inc(i,1);
  // skip userChatting
  if userHideErrors in state then inc(i,2);
  if userHideAnnouncements in state then inc(i,4);
  if userCloaked in state then inc(i,8);
  if userHideBans in state then inc(i,16);
  if userHideChange in state then inc(i,32);
  if userHideKill in state then inc(i,64);
  if userHideLevel in state then inc(i,128);
  if userHideServer in state then inc(i,256);
  if userHideMuzzle in state then inc(i,512);
  if userHidePort in state then inc(i,1024);
  if userHideWallop in state then inc(i,2048);
  if userHideCloak in state then inc(i,4096);
  if userHideFlood in state then inc(i,8192);
  if userHidePM in state then inc(i,16384);
  if userHideWhois in state then inc(i,32768);
  if userHideFriends in state then inc(i,65536);
  if userHideChannel in state then inc(i,131072);
  if userHideRegister in state then inc(i,262144);
  if userHideVar in state then inc(i,524288);
  if userHideBrowse in state then inc(i,1048576);
  if userHideMotd in state then inc(i,2097152);
  if userHidePing in state then inc(i,2097152*2);
  Result:=i;
end;

function  Int2UserState(n: Integer; chatting: Boolean): TUserState;
var
 st: TUserState;
begin
  st:=[];
  if chatting then st:=[userChatting];
  if (n and 1)<>0 then st:=st+[userMuzzled];
  if (n and 2)<>0 then st:=st+[userHideErrors];
  if (n and 4)<>0 then st:=st+[userHideAnnouncements];
  if (n and 8)<>0 then st:=st+[userCloaked];
  if (n and 16)<>0 then st:=st+[userHideBans];
  if (n and 32)<>0 then st:=st+[userHideChange];
  if (n and 64)<>0 then st:=st+[userHideKill];
  if (n and 128)<>0 then st:=st+[userHideLevel];
  if (n and 256)<>0 then st:=st+[userHideServer];
  if (n and 512)<>0 then st:=st+[userHideMuzzle];
  if (n and 1024)<>0 then st:=st+[userHidePort];
  if (n and 2048)<>0 then st:=st+[userHideWallop];
  if (n and 4096)<>0 then st:=st+[userHideCloak];
  if (n and 8192)<>0 then st:=st+[userHideFlood];
  if (n and 16384)<>0 then st:=st+[userHidePM];
  if (n and 32768)<>0 then st:=st+[userHideWhois];
  if (n and 65536)<>0 then st:=st+[userHideFriends];
  if (n and 131072)<>0 then st:=st+[userHideChannel];
  if (n and 262144)<>0 then st:=st+[userHideRegister];
  if (n and 524288)<>0 then st:=st+[userHideVar];
  if (n and 1048576)<>0 then st:=st+[userHideBrowse];
  if (n and 2097152)<>0 then st:=st+[userHideMotd];
  if (n and (2097152*2))<>0 then st:=st+[userHidePing];
  Result:=st;
end;}

function  Color2HTML(c: Integer): String;
var
 r,g,b: Integer;
begin
 r:=c and 255;
 g:=(c div 256) and 255;
 b:=(c div 65536) and 255;
 Result:='#'+IntToHex(r,2)+IntToHex(g,2)+IntToHex(b,2);
end;

function Time2Str(t: time_t): String;
var
 hours,min,sec: Integer;
 str: String;
begin
 sec:=t mod 60;
 t:=t div 60;
 min:=t mod 60;
 t:=t div 60;
 hours:=t mod 24;
 str:='';
 if hours>0 then
 begin
   str:=IntToStr(hours)+':';
   if min<10 then str:=str+'0';
 end;
 str:=str+IntToStr(min)+':';
 if sec<10 then str:=str+'0';
 str:=str+IntToStr(sec);
 Result:=str;
end;

function  Str2Time(str: String): time_t;
var
 sec, min, hours: Integer;
 str1: String;
begin
 hours:=0;
 min:=0;
 if Length(str)>6 then
 begin
   // 1:00:00
   str1:=Copy(str,1,Length(str)-6);
   hours:=StrToIntDef(str1,0);
 end;
 if Length(str)>5 then
   str:=Copy(str,Length(str)-4,5);
 if Length(str)>3 then
 begin
   // 1:00
   str1:=Copy(str,1,Length(str)-3);
   min:=StrToIntDef(str1,0);
 end;
 str1:=Copy(str,Length(str)-1,2);
 sec:=StrToIntDef(str1,0);
 Result:=sec+60*min+3600*hours;
end;

function  StringCRC(str: String; lower_case: Boolean): Word;
var
 c: Char;
begin // counts 2-byte CRC of string. used for faster comparison
 result:=Length(str);
 if result>0 then
 begin
   c:=str[result];
   if lower_case then
     if (c >= 'A') and (c <= 'Z') then inc(c, 32);
   result:=Ord(c)+256*result;
 end;
 // using last character of string instead of first because almost all databases are already sorted by first character
end;

procedure StartLogStartup;
var
 f: TFileStream;
begin
 try
  StartupLogFile := ApplicationDir+'startup.log';
  if FileExists(StartupLogFile) then
   DeleteFile(StartupLogFile);
  f:=TFileStream.Create(StartupLogFile,fmCreate);
  f.Free;
  except
 end;
end;

procedure LogStartup(str: String);
var
 f: TFileStream;
begin
 try
   f:=TFileStream.Create(StartupLogFile,fmOpenWrite or fmShareDenyWrite);
   f.Seek(0,2);
   str:=str+#13#10;
   f.Write(str[1],Length(str));
   f.Free;
  except
 end;
end;

// db_msgservを暗号化してdengonファイルに保存する
// crypt.pasのEncryptsを呼ぶ
procedure MataParaEncrypt(var DB: TStringHash; const PassWord, FileName: String);
const
  BuffSize = 1024;
  HeaderSize = 44;
var
  I, Blk, MLen, FTime: Integer;
  Buff: PChar;
  FS, MS: TStream;
  List: TMyStringList;
begin
  FS := TFileStream.Create(FileName, fmCreate);
  MS := TMemoryStream.Create;
  Buff := AllocMem(BuffSize);
  List := TMyStringList.Create;
  try
    StrHash_CopyToStringList(DB, List);
    List.SaveToStream(MS);
    FTime := FileAge(FileName);
    MS.Seek(0, soFromBeginning);
    Blk  := MS.Size div BuffSize;
    SetPassWord(Buff, PassWord, FTime);
    FS.WriteBuffer(Buff^, HeaderSize);
    for I := 0 to Blk - 1 do
    begin
      MS.ReadBuffer(Buff^, BuffSize);
      Encrypts(Buff, BuffSize, PassWord);
      FS.WriteBuffer(Buff^, BuffSize);
    end;
    MLen := MS.Size mod BuffSize;
    if MLen > 0 then
    begin
      MS.ReadBuffer(Buff^, MLen);
      Encrypts(Buff, MLen, PassWord);
      FS.WriteBuffer(Buff^, MLen);
    end;
  finally
    FS.Free;
    MS.Free;
    FreeMem(Buff);
    List.Free;
  end;
end;

// 暗号化されたdengonファイルを内部で複号してdb_msgservに格納する
// crypt.pasのDecryptsを呼ぶ
procedure MataParaDecrypt(var DB: TStringHash; const PassWord, FileName: String);
const
  BuffSize = 1024;
  HeaderSize = 44;
var
  I, Blk, MLen, FTime: Integer;
  Buff: PChar;
  FS, MS: TStream;
  List: TMyStringList;
  PW: String;
begin
  // 暗号化されていなければ暗号化
  if not IsCrypted(FileName) then
    EncryptsFile(FileName, PassWord, False);
  FS := TFileStream.Create(FileName, fmOpenRead or fmShareDenyWrite);
  MS := TMemoryStream.Create;
  Buff := AllocMem(BuffSize);
  try
    if FS.Size < HeaderSize - 9 then Exit;
    Blk := (FS.Size - HeaderSize) div BuffSize;
    FS.ReadBuffer(Buff^, HeaderSize);
    PW := GetPassWord(Buff, FTime);
    if PassWord <> PW then Exit;
    for I := 0 to Blk - 1 do
    begin
      FS.ReadBuffer(Buff^, BuffSize);
      Decrypts(Buff, BuffSize, PassWord);
      MS.WriteBuffer(Buff^, BuffSize);
    end;
    MLen := (FS.Size - HeaderSize) mod BuffSize;
    if MLen > 0 then
    begin
      FS.ReadBuffer(Buff^, MLen);
      Decrypts(Buff, MLen, PassWord);
      MS.WriteBuffer(Buff^, MLen);
    end;
    List := TMyStringList.Create;
    try
      MS.Seek(0, soFromBeginning);
      List.LoadFromStream(MS);
      StrHash_Clear(DB);
      for I := List.Count - 1 downto 0 do
        StrHash_Add(DB, List[I]);
    finally
      List.Free;
    end;
  finally
    FreeMem(Buff);
    FS.Free;
    MS.Free;
  end;
end;

function IsCrypted(FileName: String): Boolean;
const
  HeaderSize = 44;
  BuffSize = 1024;
var
  FTime: Integer;
  Buff: PChar;
  FS: TStream;
  PW: String;
begin
  Result := False;
  // dengonファイルがなければ生成する
  if not FileExists(FileName) then
  try
    FS:=TFileStream.Create(FileName, fmCreate);
    FS.Free;
  except
  end;
  FS := TFileStream.Create(FileName, fmOpenRead);
  Buff := AllocMem(BuffSize);
  try
    if FS.Size < HeaderSize - 9 then Exit;
    FS.ReadBuffer(Buff^, HeaderSize);
    PW := GetPassWord(Buff, FTime);
    if PW <> '' then Result := True;
  finally
    FreeMem(Buff);
    FS.Free;
  end;
end;

begin
 levels[0]:='Leech';
 levels[1]:='User';
 levels[2]:='Moderator';
 levels[3]:='Admin';
 levels[4]:='Elite';
 levels[5]:='Console';
 bandwidth_checkcount:=0;
end.

