unit MyLib;
{zakladni pomocne funkce, konstanty, typy, nezbytne file funkce pred inic. overlay}
{i pro Turbo Vision}
{$I define.pas}
interface
{$X+,F+}
uses
  MyType, TVType, SysUtils, WinProcs;

const
  ioError: integer = 0; { nastavuje se na hodnotu ioresult pri chybach }

const
  CrLf:array[0..1]of char = (#13,#10);
  truevalue:boolean = true;
  falsevalue:boolean = false;
  DefaultProgressBox:pointer = pointer(1);

const
  txHintOffset = 5000;
{position constants used in SelectFlagInputLine(x,y) method}
  poLeft = -1;{one pos}
  poTop = -2;{upper pos}
  poRight = -3;{one pos}
  poBottom = -4;{down pos}
  poUp = -5;{one pos}
  poDown = -6;{one pos}
  poHome = -7;{first avail x}
  poEnd = -8;{last avail x}

const
  {storage objects types, all know
    seek, getpos, getsize, read, write procedures
    (and StorageObjectType fn)
  to get data to/from them:}
  soRAM = 0;{for this type just read directly from RAM, no object defined}
  soMemPage = 1;{mempage unit}
  soRamStorage = 2;{ramstor unit}

const
  ThreeDots = '...';{used in initmenubar}
  SubMenuChar = #31;
  BitsPerByte = 8;

{  debug:boolean=false;}
  MaxByte = 255;
  MaxWord = 65535;
  MaxBufferSize = 65521;
  MaxInteger = MaxInt;
  MaxShortInt = 127;
  MinShortInt = -128;
  MinInteger = -32768;
{  MinLongInt = -2147483648; predefined}
  MaxReal = 1.0E32;
  MinReal = -1.0E32;
  PrinterName: namestr = 'PRN';
  SpaceChar: char = ' ';
  BlankString: string = '';
  {CRLF: array[0..1] of byte = (13,10);}
  UnknownMode = 0;
  MonoMode = 1;
  BW80Mode = 2;
  CO80Mode = 3;
  VLow = 0;
  VNorm = 1;
  VReverse = 2;

type
  TDOW = byte;
  MinString = string[1];
{$IFDEF WINDOWS}
{  SearchRec = record
    Fill: array[1..21] of Byte;
    Attr: Byte;
    Time: Longint;
    Size: Longint;
    Name: array[0..12] of Char;
  end;}

{$ENDIF}

{  PByteBuffer = ^TByteBuffer;
  TByteBuffer = array[0..pred(MaxWord)] of byte;
  PCharBuffer = ^TCharBuffer;
  TCharBuffer = array[0..pred(MaxWord)] of char;}
  TConversionTable = array [0..255] of char;
  TStreamBuffer = array[0..1023] of byte;

  string1 = string[1];
  string5 = string[5];
  string6 = string[6];
  string8 = string[8];
  string12 = string[12];
  string20 = string[20];
  String80 = string[80];
  TDelimiterStr = string[40];
  TDelimStr = string[40];
  TPortNameStr = string[8]{NameStr};
  TWordMask = array [0..15] of word;
  PExtStr = ^ExtStr;
  PPathStr = ^PathStr;
  PFile = ^file;
  TCharStr = string[1];

var
  VideoMode: Byte;

const
  DOWLen = 1;

  WordMask:TWordMask =
  ($1   ,$2   ,$4   ,$8   ,$10  ,$20  ,$40  ,$80  ,$100 ,$200 ,$400 ,$800 ,
   $1000,$2000,$4000,$8000);

   {max allowed length of password}
  MaxPasswordLen = 20;
  MinPasswordLen = 4; {if password shoter then this, appended some chars during
    encoding}
  MaxUserNameLen = 20;
const
{FindMode constants (used in txtficol, dbf)}
  fmExact = 0;
  fmLeftSubstring = 1;
  fmSubstring = 2;
  fmRightSubstring = 3;

  fmCaseInSensitive = $10;

type
  TPasswordString = string[MaxPasswordLen];
  TUserNameString = string[MaxUserNameLen];
  TEncryptErrorProcedure = procedure (ErrorCode: integer);
  TInputErrorProcedure = procedure (ErrorCode: integer);

const
  EncryptError: pointer = nil;
  InputError: pointer = nil;

  MaxProgressChars = 5;
  ProgressChars : array[0..pred(MaxProgressChars)] of char = ('-','\','|','-','/');

const
{keyboards KeyCode constants not defined in drivers}
  kbSpace = $3920;

function MakeCheckSum(var Buf; Size:word):Word;

(******************** Numeric Functions *************************)

function exp10(i:integer): real;

function log(x:real): real;

function tan(r:real):real;

function sgn(r:real):integer;

procedure getmanlog(r:real;var m:real;var l:integer);

function Min(N1, N2 : Longint) : Longint;
{ Returns the smaller of two numbers }

function Max(N1, N2 : Longint) : Longint;
{ Returns the larger of two numbers }

(*******************************************************************)


function endpos(ch:char;st:string):integer;

(*
function numberout(r:real;templ:string):string;
{prevadi cislo r do tvaru daneho templ (jako v print using v basicu):
 povolene znaky v templ:        ve vystupu bude:
          #                     -,0..9,mezera pro pocatecni nebo konc. nuly;
          0..9                  -,0..9,0 pro pocatecni nebo konc. nuly;
          +                     + pro kladne cislo, - pro zaporne;
          -                     - pro zap. cislo, mezera pro kladne;
          .                     .
          E                     E}

*)
{function deltilde(s:string):string;}

{function locase(ch:char):char; see country unit stru}

{function uppcase(st:string):string;}

(***************************************************************)

(********************** System functions ************************************)

function paramreal(i:byte):real;

function paramint(i:byte):integer;

{function getshortdir(s:string; l:byte):string;}
{vraci jmeno adresare zkracene na delku l}

procedure inccirc(var value:word; base:word; incc:integer);
{increment value, don't exceed base (set to 0 if necessary)}

procedure incp(var pt;step:integer);
{zvetsi posici na niz ukazuje pointer p o step bytu}

{*************************** File Functions  *******************************}

function DriveValid(Drive: Char): Boolean;

{***************************************************************************}
{***************************************************************************}
{***************************************************************************}

FUNCTION PrinterOK(PrinterPort: word):Boolean;
{ Returns true if printer is OK. LPT1 = 0, LPT2 = 1, ... }
(*
function DelBackSlash(Dir : DirStr) : DirStr;

function AddBackSlash(Dir : DirStr): DirStr;

function ReplaceExt(FileName: PathStr; NExt: ExtStr; Force: Boolean):Pathstr;
function ReplaceDir(FileName: PathStr; NewDir: DirStr; Force:boolean):PathStr;

function GetEXEName:pathstr;
function GetEXEDir : DirStr;
function GetFileBaseName(AFileName:PathStr):NameStr;
function GetFileExt(AFileName:PathStr):ExtStr;
function GetFileDir(AFileName:PathStr):DirStr;
*)
procedure MChDir(Dir : DirStr);

function FExists(FileName: PathStr): Boolean;

function ConvStreamName(AFileName:PathStr):FNameStr;{tdosstream}
{function ConvSearchName(var Buf):String;{converts SearchRec.Name}

procedure FreeObject(PointerToPObject:pointer);
procedure FreePString(PointerToPString:pointer);

function SetString(var APString:PString; AString:string):boolean;
function GetString(APString:PString):string;{returns '' for nil, otherwise APString^}
function GetStrPas(AStr:PChar):string;{as StrPas but returns '' if AStr = nil}

function ChangeBuffer(NewSize:TBufSize; var Buf:PBuf; var OldNewSize:TBufSize):boolean;

{$IFDEF PMODE}
function GetCString(AChar:PChar):string;
{$ENDIF}
{$IFDEF WINDOWS}
procedure FSplit(AFileName:PathStr; var ADir:DirStr; var AName:NameStr; var AExt:ExtStr);
{$ENDIF}

{$IFNDEF WIN32}
procedure SetLength(var S:String; NewLength:integer);
{$ENDIF}

implementation


{$IFDEF WIN32}
function MakeCheckSum(var Buf; Size: Word): Word; assembler;
var {mytype}
  B:TByteBuffer absolute Buf;
  I,C:Word;
begin
  C := 0;
  for i := 0 to Size - 1 do begin
    Inc(C, B[i]);
  end;
  MakeCheckSum := C;
end;
{$ELSE}
function MakeCheckSum(var Buf; Size: Word): Word; assembler;
asm
	PUSH	DS
	LDS	SI,Buf
        XOR     DX,DX
        XOR     AH,AH
	CLD
	MOV	CX,Size
@@1:	LODSB
	ADD	DX,AX
	LOOP	@@1
        MOV     AX,DX
	POP	DS
end;
{$ENDIF}

function exp10{(i:integer):real};
var st,he:string[40];r:real;j:integer;
begin
  st:='1.0E';
  str(i,he);
  st:=st+he;
  val(st,r,j);
  exp10:=r;
end;

function log{(x:real):real};
begin
  log:=ln(x)/ln(10)
end;

function tan(r:real):real;
begin
  tan:=sin(r)/cos(r);
end;

function sgn(r:real):integer;
begin
  if r < 0 then
    sgn:=-1
  else
    if r > 0 then
      sgn:=1
    else
      sgn:=0;
end;


procedure Beep;
begin
end;

procedure BeepHigh;
begin
end;

procedure getmanlog{(r:real;var m:real;var l:integer)};
var
  st:string;
  i:integer;
begin
  str(r,st);
  {$IFDEF WINDOWS}
    val(copy(st, 1, 17), m, i);
    val(copy(st, 19, 5), l, i);
  {$ELSE}
    val(copy(st,1,13),m,i);
    val(copy(st,15,3),l,i);
  {$ENDIF}
end;


function Min(N1, N2 : Longint) : Longint;
{ Returns the smaller of two numbers }
begin
  if N1 <= N2 then
    Min := N1
  else
    Min := N2;
end; { Min }

function Max(N1, N2 : Longint) : Longint;
{ Returns the larger of two numbers }
begin
  if N1 >= N2 then
    Max := N1
  else
    Max := N2;
end; { Max }


function paramreal{(i:byte):real};
var r:real;j:integer;
begin val(paramstr(i),r,j);paramreal:=r;end;

function paramint{(i:byte):integer};
var
  j,k:integer;
begin
  val(paramstr(i),j,k);
  paramint:=j;
end;

function endpos{(ch:char;st:string):integer};
var i:integer;
begin i:=pos(ch,st);if i=0 then i:=succ(length(st));endpos:=i;end;


(* fileu
function getshortdir(s:string; l:byte):string;
{vraci jmeno adresare zkracene na delku l}
var le,p:integer; ls,rs,ts:string;
begin
  s:= trim(s);
  le:=length(s);
  if le<=l then begin getshortdir:=pad(s,l);exit;end;
  ls:=copy(s,1,2)+'..';
  rs:=copy(s,le-l+5,le);
  p:=pos('\',rs);
  if ((p>0)and(p<length(rs))) then rs:=copy(rs,p,length(rs)-p+1);
  getshortdir:=pad(ls+rs,l);
end;
*)

procedure inccirc(var value:word; base:word; incc:integer);
{increment value, don't exceed base (set to 0 if necessary)}
begin
  if incc > 0 then begin
    inc(value, incc);
    value := value mod base;
  end else begin
    incc := (-incc) mod base;
    if incc > value then
      value := value + base - incc
    else
      dec(value, incc);
  end;
end;

procedure incp {(var pt;step:integer)};
{zvetsi posici na niz ukazuje pointer p o step}
var {s,o:word;}
  p:PChar absolute pt;
  {stp,dv,md:word;}
begin
  inc(p, step);
end;

function DriveValid(Drive: Char): Boolean; assembler;
asm
	MOV	DL,Drive
        MOV	AH,36H
        SUB	DL,'A'-1
        INT	21H
        INC	AX
        JE	@@2
@@1:	MOV	AL,1
@@2:
end;

{$IFNDEF WINDOWS}
function PathValid(var Path: PathStr): Boolean;
var
  ExpPath: PathStr;
  F: File;
  SR: SearchRec;
begin
  ExpPath := FExpand(Path);
  if Length(ExpPath) <= 3 then PathValid := DriveValid(ExpPath[1])
  else
  begin
    if ExpPath[Length(ExpPath)] = '\' then Dec(ExpPath[0]);
    FindFirst(ExpPath, Directory, SR);
    PathValid := (DosError = 0) and (SR.Attr and Directory <> 0);
  end;
end;

function ValidFileName(var FileName: PathStr): Boolean;
const
  IllegalChars = ';,=+<>|"[] \';
var
  Dir: DirStr;
  Name: NameStr;
  Ext: ExtStr;

{ Contains returns true if S1 contains any characters in S2 }
function Contains(S1, S2: String): Boolean; near; assembler;
asm
	PUSH	DS
        CLD
        LDS	SI,S1
        LES	DI,S2
        MOV	DX,DI
        XOR	AH,AH
        LODSB
        MOV	BX,AX
        OR      BX,BX
        JZ      @@2
        MOV	AL,ES:[DI]
        XCHG	AX,CX
@@1:	PUSH	CX
	MOV	DI,DX
	LODSB
        REPNE	SCASB
        POP	CX
        JE	@@3
	DEC	BX
        JNZ	@@1
@@2:	XOR	AL,AL
	JMP	@@4
@@3:	MOV	AL,1
@@4:	POP	DS
end;

begin
  ValidFileName := True;
  FSplit(FileName, Dir, Name, Ext);
  if not ((Dir = '') or PathValid(Dir)) or Contains(Name, IllegalChars) or
    Contains(Dir, IllegalChars) then ValidFileName := False;
end;

function GetCurDir: DirStr;
var
  CurDir: DirStr;
begin
  GetDir(0, CurDir);
  if Length(CurDir) > 3 then
  begin
    Inc(CurDir[0]);
    CurDir[Length(CurDir)] := '\';
  end;
  GetCurDir := CurDir;
end;
 
function IsWild(var S: String): Boolean;
begin
  IsWild := (Pos('?',S) > 0) or (Pos('*',S) > 0);
end;

function IsDir(var S: String): Boolean;
var
  SR: SearchRec;
begin
  FindFirst(S, Directory, SR);
  if DosError = 0 then
    IsDir := SR.Attr and Directory <> 0
  else IsDir := False;
end;
{$ENDIF}
{
function InvalidRect(AView:TView; R:TRect):boolean;
var dx,dy:integer;
label er;
begin
  InvalidRect:=false;
  with R do begin
    dx:=b.x-a.x;
    dy:=b.y-a.y;
    if (dx<=4) or (dy<=4) then goto er;

    with AView do begin
      if (b.x<= origin.x) or (b.y<=origin.y) then goto er;
    end;
  end;
  exit;
er:
  InvalidRect:=true;
end;
}

FUNCTION PrinterStatus(PrinterPort : word): Byte; Assembler;    { Returns status of LPT1     }
 { Definition of status byte bits (1 & 2 are not used), if set then:
  Bit: -- 7 ---  ---- 6 ----  -- 5 ---  -- 4 ---  -- 3 --  --- 0 ---
       Not Busy  Acknowledge  No paper  Selected  I/O Err  Timed out
 }
  ASM
    MOV AH,2                        { Load BIOS function.             }
    MOV DX,Printerport              { Which printer port to send to.  }
    INT 23                          { Call BIOS printer services.     }
    MOV Al,Ah                       { Return with printer status byte.}
    XOR Ah,Ah
  END;     { PrinterStatus }


FUNCTION PrinterOK(PrinterPort : word):Boolean;
{ Returns true if printer is OK. LPT1 = 0, LPT2 = 1, ... }
BEGIN
  IF (PrinterStatus(PrinterPort) AND $39) = $10 THEN
    PrinterOk := TRUE
  ELSE
    PrinterOk := FALSE;
END;   { PrinterOk }

{begin videomode:=getvideomode;}


function DelBackSlash(Dir : DirStr) : DirStr;
begin
  if (Length(Dir) > 3) then begin
    if (Dir[Length(Dir)] = '\') then begin
      {$IFDEF WIN32}
      SetLength(Dir, Length(Dir) - 1);
      {$ELSE}
      Dec(Dir[0]);
      {$ENDIF}
    end;
  end else begin
    if (Dir[Length(Dir)] = '\') then begin
      if Length(Dir) > 1 then begin
        if (Length(Dir) < 3) or (Dir[2] <> ':') then begin
          {$IFDEF WIN32}
          SetLength(Dir, Length(Dir) - 1);
          {$ELSE}
          Dec(Dir[0]);
          {$ENDIF}
        end;
      end;
    end;
  end;
  DelBackSlash := Dir;
end;
(*
function AddBackSlash(Dir : DirStr): DirStr;
begin
  if (Dir <>  '') and (Dir[Length(Dir)] <> '\') then begin
    if (Length(Dir) <> 2) or (Dir[2] <> ':') then Dir := Dir + '\';
  end;
  AddBackSlash := Dir;
end;
*)
{----- ReplaceExt(FileName, NExt, Force) -------------------------------}
{  Replace the extension of the given file with the given extension.    }
{  If the an extension already exists Force indicates if it should be   }
{  replaced anyway.                                                     }
{-----------------------------------------------------------------------}
{$IFDEF WINDOWS}
procedure FSplit(AFileName:PathStr; var ADir:DirStr; var AName:NameStr; var AExt:ExtStr);
var p:integer;
begin
  p := length(AFileName);
  ADir := '';
  AName := '';
  AExt := '';
  while (p > 0) and (AFileName[p] <> '.') do dec(p);
  if p > 0 then begin
    AExt := copy(AFileName, p, 255);
    AFileName := copy(AFileName, 1, p -1); dec(p);
  end;
  while (p > 0) and (AFileName[p] <> '\') and (AFileName[p] <> ':') do
    dec(p);
  if p > 0 then begin
    ADir := copy(AFileName, 1, p);
    AName := copy(AFileName, p + 1, 255);
  end else begin
    AName := AFileName;
  end;
end;
{$ENDIF}
(*
function ReplaceExt(FileName: PathStr; NExt: ExtStr; Force: Boolean):
  PathStr;
var
  Dir: DirStr;
  Name: NameStr;
  Ext: ExtStr;
begin
  FSplit(FileName, Dir, Name, Ext);
  if Force or (Ext = '') then
    ReplaceExt := Dir + Name + NExt else
    ReplaceExt := FileName;
end;

function ReplaceDir(FileName: PathStr; NewDir: DirStr; Force:boolean):PathStr;
var d:dirstr;n:namestr;e:extstr;
begin
  FSplit(FileName, d, n, e);
  if (d = '') or Force then
    ReplaceDir := AddBackSlash(NewDir) + n + e
  else
    ReplaceDir := FileName;
end;

const
  ExeName: PathStr = '';

function GetEXEName:pathstr;
var s:string;
{$IFDEF PMODE}
   n:array[0..255] of char;
{$ENDIF}
begin
  {$IFDEF PMODE}
  if ExeName = '' then begin
    if GetModuleFileName(HInstance, n, 255) <> 0 then begin
      ExeName := StrPas(n);
    end;
  end;
  {$ELSE}
  if ExeName = '' then begin
    if Lo(DosVersion) >= 3 then
    begin
      s := ParamStr(0);
      EXEName := FExpand(s);
      GetExeName := EXEName;
    end else
      EXEName := FExpand(FSearch('GHLink.EXE', '.;' + GetEnv('PATH')));
  end;
  {$ENDIF}
  GetExeName := EXEName;
end;

function GetEXEDir : DirStr;
var
  Dir : DirStr;
  Name : NameStr;
  Exe : ExtStr;
begin
  FSplit(GetEXEName, Dir, Name, Exe);
  GetEXEDir := Dir;
end;

function GetFileBaseName(AFileName:PathStr):NameStr;
var
  Dir : DirStr;
  Name : NameStr;
  Exe : ExtStr;
begin
  FSplit(AFileName, Dir, Name, Exe);
  GetFileBaseName := Name;
end;

function GetFileExt(AFileName:PathStr):ExtStr;
var
  Dir : DirStr;
  Name : NameStr;
  Exe : ExtStr;
begin
  FSplit(AFileName, Dir, Name, Exe);
  GetFileExt := Exe;
end;

function GetFileDir(AFileName:PathStr):DirStr;
var
  Dir : DirStr;
  Name : NameStr;
  Exe : ExtStr;
begin
  FSplit(AFileName, Dir, Name, Exe);
  GetFileDir := Dir;
end;
*)

procedure MChDir(Dir : DirStr);
begin
  Dir := DelBackSlash(Dir);
  {$I-}
  chdir(dir);
  ioError := ioresult;
  {$I+}
end;

function FExists(FileName: PathStr): Boolean;
{$IFNDEF WINDOWS}
var
  F: file;
  Attr: Word;
{$ENDIF}
begin
  {$IFDEF WINDOWS}
  FExists := FileExists(FileName);
  {$ELSE}
  ioError:=0;
  Assign(F, FileName);
  GetFAttr(F, Attr);{sysutils}
  FExists := (DosError = 0);
  {$ENDIF}
end;

function ConvStreamName(AFileName:PathStr):FNameStr;{objects}
var b:array[0..255] of char;
begin
{$IFDEF WINDOWS}
  ConvStreamName := StrPCopy(b, AFileName);
{$ELSE}
  ConvStreamName := AFileName;
{$ENDIF}
end;

(*
function ConvSearchName(var Buf):String;{converts SearchRec.Name}
var P:array[0..255]of char absolute Buf;
    S:string absolute Buf;
begin
{$IFDEF WINDOWS}
  ConvSearchName := StrPas(P);
{$ELSE}
  ConvSearchName := S;
{$ENDIF}
end;
*)

{$IFDEF WIN32}
procedure FreeObject(PointerToPObject:pointer);
var
  PtrToObject : ^TObject absolute PointerToPObject;
begin
  if PtrToObject = nil then
    exit;
  if PtrToObject^ = nil then
    exit;
  PtrToObject^.Free;
  PtrToObject^ := nil;
end;
{$ELSE}
procedure FreeObject(PointerToPObject:pointer);
var
  PtrToPObject : ^PObject absolute PointerToPObject;
begin
  if PtrToPObject = nil then
    exit;
  if PtrToPObject^ = nil then
    exit;
  Dispose(PtrToPObject^, Done);
  PtrToPObject^ := nil;
end;
{$ENDIF}

procedure FreePString(PointerToPString:pointer);
var
  PtrToPString  : ^PString absolute PointerToPString;
begin
  if PtrToPString = nil then
    exit;
  DisposeStr(PtrToPString^);{pstring}
  PtrToPString^ := nil;
end;

function SetString(var APString:PString; AString:string):boolean;
begin
  SetString := false;
  DisposeStr(APString);
  APString := nil;
  if AString <> '' then begin
    APString := NewStr(AString);
    if APString = nil then
      exit;
  end;
  SetString := true;
end;

function GetString(APString:PString):string;{returns '' for nil, otherwise APString^}
begin
  if APString = nil then
    GetString := ''
  else
    GetString := APString^
end;

function GetStrPas(AStr:PChar):string;
begin
  if AStr = nil then
    GetStrPas := ''
  else
    GetStrPas := StrPas(AStr);
end;

function ChangeBuffer(NewSize:TBufSize; var Buf:PBuf; var OldNewSize:TBufSize):boolean;
begin
  ChangeBuffer := false;
  if NewSize <> OldNewSize then begin
    if Buf <> nil then
      FreeMem(Buf, OldNewSize);
    Buf := nil;
    OldNewSize := 0;
    if NewSize > 0 then begin
      GetMem(Buf, NewSize);
      if Buf = nil then begin
        exit;
      end else
        OldNewSize := NewSize;
    end;
  end;
  ChangeBuffer := true;
end;


{$IFDEF PMODE}
function GetCString(AChar:PChar):string;
begin
  if AChar = nil then
    GetCString := ''
  else
    GetCString := StrPas(AChar);
end;
{$ENDIF}

{$IFNDEF WIN32}
procedure SetLength(var S:String; NewLength:integer);
begin
  S[0] := chr(Lo(NewLength));
end;
{$ENDIF}

end.