{**********************************************************************
Copyright (C) 2009 by Salvatore Licciardi

Web http://www.webalice.it/turylicciardi    eMail turylicciardi@tiscali.it

 This program is free software: you can redistribute it and/or modify it under
 the terms of the GNU General Public License as published by the Free Software
 Foundation, version 3 of the License.
 This program is distributed in the hope  that it will be useful , but WITHOUT
 ANY WARRANTY without even the implied warranty  of MERCHANTABILITY or FITNESS
 FOR A PARTICULAR PURPOSE.
 See the GNU General Public License for more details. You should have received
 a copy of the GNU General Public License along with this program. If not, see
 http://www.gnu.org/licenses/

 **********************************************************************}

unit ALTRO32;  {Unit con particolari funzioni e procedure per DOS/Win 32 bit}
{$ASMMODE intel}
{$MODE ObjFpc}
{$MACRO on}
{$H+}  // longstring

 interface

{$ifdef Win64}
 {$define Win32}
{$endif}
 uses Crt,SysUtils,Dos,Strings,Math
      {$IFDEF Go32V2}
      ,MsMouse
      {$ENDIF}
      {$ifdef OS2}
      ,PopUpErr
      {$endif}
      {$ifdef Win32}
      ,PopUpErr
      {$endif}
      ;

 const invio=LineEnding;
       {$ifdef Linux}
        c_UR2='+';
        c_UL2='+';
        c_DR2='+';
        c_DL2='+';
        c_D2 ='=';
        c_U2 ='|';

        c_DR1='+';
        c_DL1='+';
        c_UR1='+';
        c_UL1='+';
        c_D1 ='-';
        c_U1 ='|';
        c_CU1='+';
        c_CD1='+';
        c_CL1='+';
        c_CR1='+';

        c_B  ='|';
        c_FU ='/';
        c_FD ='\';
        c_FL ='>';   // freccia sinistra
        c_FR ='<';   // freccia destra
        c_S  ='X';   // blocco selezionato
       {$else}
        c_UR2='»';
        c_UL2='É';
        c_DR2='¼';
        c_DL2='È';
        c_D2 ='Í';
        c_U2 ='º';

        c_DR1='Ù';
        c_DL1='À';
        c_UR1='¿';
        c_UL1='Ú';
        c_D1 ='Ä';
        c_U1 ='³';
        c_CU1='Â';
        c_CD1='Á';
        c_CL1='Ã';
        c_CR1='´';

        c_B  ='±';  // blocco non selezionato
        c_FU =#24;  // freccia alta
        c_FD =#25;  // freccia bassa
        c_FL =#16;  // freccia sinistra
        c_FR =#17;  // freccia destra
        c_S  =#9;   // blocco selezionato
       {$endif}

       {$ifdef Win64}
       bit=64;
        {$else}
       bit=32;
       {$endif}

       web='http://www.webalice.it/turylicciardi';
       mail='turylicciardi@tiscali.it';
       {$ifdef OS2}
       CO80=3;
       {$endif}
       {$ifdef Go32v2}
       os_prog='DOS';
       {$ENDIF}
       {$ifdef Win32}
       os_prog='WIN';
       {$ENDIF}
       {$ifdef OS2}
       os_prog='OS2';
       {$ENDIF}
       {$IFDEF Linux}
       os_prog='LNX';
       {$ENDIF}

          {***FILE***}
{$IFDEF Linux}
function getshortname(var s:shortstring):boolean;
function getlongname(var s:shortstring):boolean;
{$ENDIF}
{$IFDEF OS2}
function getshortname(var s:shortstring):boolean;
function getlongname(var s:shortstring):boolean;
{$ENDIF}
function Attr(s:string):string;
function contaThis(path,nome:string):longint;
function contaDirFile(s:string):longint;
function contaDir(s:string):longint;
function contaFile(s:string):longint;
  { tornano rispettivamente quanti file e directory, directory, files
    ci sono in una directory, -1 se non e' una directory }
function  ValidNameWin(s:string):byte;
  { torna 0 se il nome del file (path opzionale) e' valido per Windows,
    altrimenti la posizione dove inizia l'errore }
function  ValidNameDOS(s:string):byte;
  { torna 0 se il nome del file (path opzionale) e' valido per DOS,
    altrimenti la posizione dove inizia l'errore }
function  ValidNameOS2(s:string):byte;
function  ValidNameLinux(s:string):byte;
function  ValidName(s:string):byte;
  { torna 0 se il nome del file (path opzionale) e' valido, altrimenti la
    posizione dove inizia l'errore. Fa un autodetect del sistema operativo }
function SubDir(path,tmpfiles:string):byte;
  { data una directory, crea nel file tmpfiles la struttura delle
    sottodirectory della directory indicata sottoforma di stringhe.
    Le stringhe sono di 256 caratteri, i caratteri che non appartengono alle
    sottodirectory sono il carattere di ordinata 0.
    Torna: 0= (sovra) scrittura avvenuta con successo
           1= scrittura su file fallita
           2= operazione interrotta dall'utente
   il file non viene cancellato se la funzione torna 1 o 2.
   Se il file e' vuoto, significa che non ci sono sottodirectori, o non
   esiste quella indicata }
function  TmpFile(ilFile:string):string;
  { torna il percorso+nome del file temporaneo, guarda le variabili d'ambiente }
function  NewDir(dir:string):integer;
  { crea una directory e sottodirectory }
function  TruncPath(str:string; Max:byte):string;
  { dato percorso e/o nomefile , ed una lunghezza massima, ne restituisce
    l'equivalente abrreviato con  U:\...\?????????? o lo stesso se non e'
    possibile abbreviarlo }
function  PathOf(stringa:string):string;
  { dato un cammino, restituisce il percorso senza file: finira' con : o \}
function  NameOf(s:string):string;
  { dato un cammino, restituisce il file senza percorso }
function NameOf_No_Ext(s:string):string;
  { dato un cammino, restituisce il file senza percorso e senza estensione}
function  Exist(nome:string):int64;
  { controlla se esiste un path+file non accetta caratteri jolli (*,?) .
    Se non esiste ritorna -1, altrimenti la dimensione del file }
function  NameReserved(str:string):boolean;
  { data una stringa indica se e' lecita usarla come nome di file: il nome
    potrebbe essere riservato al DOS. Torna true se e' riservata,
    altrimenti false }
function  CharReserved(s:string; jolly:boolean):byte;
  { data una stringa indica se e' lecita usarla come nome di file: il nome
    potrebbe contenere caratteri riservati al DOS. Torna la posizione del
    carattere se ve ne e',altrimenti 0. Jolly indica se considerare anche
    ? e * come riservati.
    Caratteri riservati: ,;=+ /:|<>" e  0..31 }
function  CharDriver(s:string):char;
  { data una stringa ne torna il driver se valido, altrimenti il carattere 0 }
function  NumDriver(s:string):byte;
  { data una stringa ne torna il numero del driver se valido, altrimenti 255 }
function  DirEmpty(s:string):boolean;
  { data una stringa, torna true se l'equivalente della directory e' vuota,
    false se non lo e' o non esiste }
function  isDir(s:string):boolean;
  { data una stringa, torna true se l'equivalente della directory esiste,
    false se non c'e' o non lo e' }
function ExpandEnvironment(s:string):string;
  { converte le variabili d'ambiente di un percorso, senza espanderlo, se tutte
    corrette ( %xxx% ) }
function  FExpand2(s:string):string;
  { come FExpand, ma converte pure le variabili d'ambiente se tutte corrette
    ( %xxx% ) }
function  lettere_unita():string;   // GetLogicalDriveString

          {***STRINGHE e NUMERI***}
function  copy_end(s:string; origine:longint):string;
function  str_is_int(s:string):boolean;
// procedure StrToInt(str:string; var v:int64; var pos_err:integer);
procedure Reverse(var str:string);
procedure Exchange(var a,b:char);
procedure Exchange(var a,b:byte);
procedure Exchange(var a,b:longint);
procedure Exchange(var a,b:Int64);
procedure Exchange(var s1,s2:string);
procedure Testa_Coda(str,ins:string; var testa,coda:string);
procedure Val_Try(Stringa:string; var n:Int64; var pos_err:word);   // ver 2.10
procedure Val_Try(Stringa:string; var n:longint; var pos_err:word); // ver 2.10
procedure Val_Try(S:string; var n:real; var pos_error:word);        // ver 2.10
function  StringToPChar(s:string):PChar;
function  UpStr(c:string):string;
function  FreeChar(c,s:string):string;
function  DecimalTo(numdec:longint; newBase:byte):string;
function  ToDecimal(num:string; oldBase:byte):string; {converte da base 2..16 a decimale}
function  FromTo(oldV:string; oldB,newB:byte):string; {converte da base a base (2..16)}
function  Bool(b:boolean):byte; {torna 1 se b=true, 0 se b=false}
function  Bool(b:longint):boolean; {torna false se b=0 , altrimenti true}
function  BoolToStr(b:boolean):string; {torna 'True' se b=true, 'False' se b=false}
function  Union(s1,s2:string):string;
function  Intersection(s1,s2:string):string;
function  Single(str:string):string; {toglie i caratteri ripetuti}
function  fDelete(Str: String; Index,Count:Integer):string; {come il delete}
function  Dim_Punto(num:int64):string;   {raggruppa le cifre a 3 a 3}
function  fReverse(str:string):string;   {inverte una stringa}
function  PosRL(sub,str:string; start:byte):byte;     { cerca una stringa partendo da start da DS }
function  Conta(str,stringa:string; start:byte; b:boolean):byte;
  { conta quante volte str compare in stringa a partire da start, se b=true a destra di start,
    altrimenti a sinistra }
function  CopyRL(str :string; start,count:integer):string; { copia da D verso S }
function  SostituisciLR(n:byte; sub,str,stringa:string):string; { da sinistra
    verso destra, sostituisce l' n-sima stringa sub, con str nella stringa }
function  SostituisciRL(n:byte; sub,str,stringa:string):string;
  { da destra verso sinistra, sostituisce l' n-sima stringa sub, con str nella stringa }
function  Digits(c:char):boolean;  {torna true se il carattere e' un numero}
function  Letters(c:char):boolean; {torna true se il carattere e' una lettera}
function  PosStart(sub,s:string; start:byte):byte;     {cerca una stringa partendo da start}
function  PosJolly(sub,str:string; start:byte):byte;   {cerca una stringa jolly partendo da start SD}
function  PosJollyRL(sub,str:string; start:byte):byte; {cerca una stringa jolly partendo da start da DS}

          {***TEMPO***}
procedure Delay2(tempo:longint); {ritardo in centesimi di secondo reali}
procedure Skip;
function  Time100:longint;       {restituisce il tempo attuale in centesimi}

          {***COLORI***}
function  BackColor:byte;  {indica il colore di background nella pos attuale}
function  TxtColor:byte;   {indica il colore di textcolor nella pos attuale}
function  Lamp:boolean;    {indica se c' e' il lampeggio nella pos attuale}
function  BackColorXY(x,y:byte):byte; {indica il background dove specificato}
function  TxtColorXY(x,y:byte):byte;  {indica il textcolor dove specificato}
function  LampXY(x,y:byte):boolean;   {indica il lampeggio dove specificato}

          {***CARATTERI e VIDEO***}
function  Char_Video:char;      {indica il carattere nella pos attuale}
function  Char_VideoXY(x,y:byte):char; {torna il carattere dove indicato}
function  LowCase(c:char):char; {da maiuscolo a minuscolo}
function  GetTextMaxY:word;
function  GetTextMaxX:word;

          {***MOUSE***}
procedure Rilascio(var mox,moy,tasto:byte); {restituisce rilascio SX del mouse in mox,moy,tasto}
procedure RilascioDestra(var mox,moy,tasto:byte); {restituisce rilascio DX del mouse in mox,moy,tasto}
procedure Click(var mox,moy,tasto:byte);    {restituisce il click del mouse in mox,moy,tasto}

          {***TASTIERA***}
{ function  Tasti_Speciali:byte;   per shift,ctrl.alt... da non interfacciare esternamente }
function  Alt:boolean;           {true se Alt premuto}
function  Shift:boolean;         {true se Shift premuto}
function  Ctrl:boolean;          {true se Ctrl premuto}
function  from_alt_to_char(b:byte):char;
function  from_alt_to_char(s:String):char;
procedure Tast_Vuota;            {svuota il buffer della tastiera}
procedure keyspeed(delay,rate:byte);

          {***MATEMETICA***}
function  IsInt(X: real): boolean;  {Torna vero se il numero e' un intero es: 4,000000000000}
function  SIGN (R: real): real;     {ritorna -1 se R<0, 0 se R=0, o 1 se R>0.}
function  FACT (n: integer): real;  {Ritorna il fattoriale di un numero tra 0..33, -1 altrimenti}
function  DegToRad(gr:real):real;   {converte da gradi a radianti}
function  RadToDeg(rad:real):real;  {converte da radianti a gradi}
function  Intersezione(y11,y12,y21,y22:longint):boolean;
function  Lunghezza_Intersezione(y11,y12,y21,y22:int64):int64;
procedure Intersezione_tra(y11,y12,y21,y22:int64; var a,b:int64);
 { se torna a=1 e b=0, significa che l'interseione e' vuota }


implementation

var StringToPchar_:array[0..1023] of char;

{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}

procedure Skip;
begin
end;

{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}

function Time100:longint;     {restituisce il tempo attuale in centesimi}
var h,m,s,cs:word;
begin
GetTime(h,m,s,cs);
Time100:=(h*60*60+m*60+s)*100+cs;
end;

{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}

procedure KeySpeed(delay,rate:byte);
begin      // funziona anche in Win95/98/Me, non funziona in NT
{$ifdef go32v2}
asm
 mov ah,03
 mov al,05
 mov bh,delay   // delay ritardo
 mov bl,rate    // rate  frequenza
 int 16h
 end;
{$endif}
end;

{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}

function ValidNameWin(s:string):byte;

{---------------------------------------------------------------------------}

function CharReserved(s:string; jolly:boolean):byte;
var posto,i:byte;    {escluso i caratteri jolly ?*}
    bad:string;
begin
bad:='/:|<>"';
if jolly then bad:=bad+'?*';
for i:=0 to 31 do bad:=bad+char(i);
if not lfnsupport then bad:=bad+#32;
CharReserved:=0;
for i:=1 to length(bad) do
    begin
    posto:=byte(pos(bad[i],s));
    if posto<>0 then Exit(posto);
    end;
end;

{---------------------------------------------------------------------------}

var testa,coda:string;
    posto,posto1:integer;
begin
testa:=s;
if testa='' then Exit(1);
if testa[length(testa)]='.' then Exit(length(testa));

                               {controllo se il ':' e' valido}
if copy(testa,1,2)='\\' then        { net }
                         begin
                         if pos(':',testa)<>0 then exit(pos(':',testa));
                         end
                        else
                         begin
                         posto:=CharReserved(testa[1]+Copy_end(testa,3),false);
                         if posto>1 then inc(posto);
                         if posto<>0 then Exit(posto);
                         end;

{? e * non possono stare prima dell'ultimo \}
posto:=pos('?',testa);
if posto=0 then posto:=257;
posto1:=pos('*',testa);
if posto1=0 then posto1:=257;
posto:=min(posto,posto1);
if posto<PosRL('\',testa,255) then Exit(posto);

if Copy(testa,2,1)=':' then      {controllo se il ':' e' valido}
   begin
   if Letters(testa[1])=false then Exit(1);
   testa:=Copy(testa,3,255);
   end;

posto:=pos('\\',copy(testa,2,255));
if posto>0 then Exit(posto);

if copy(testa,1,2)='\\' then testa[1]:='A'; { \\... deve divetare valido, ad esempio A\... }
while (testa<>'') do
          begin
          Testa_Coda(testa,'\',testa,coda);
          if (testa[1]='\')and(testa<>'\') then testa:=Copy_end(testa,2);
          if (testa='') or NameReserved(testa) then Exit(Length(s)-length(coda)+1-length(testa));
          testa:=coda;
          end;
ValidNameWin:=0;
end;

{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}

function ValidNameLinux(s:string):byte;

{---------------------------------------------------------------------------}
(*
function CharReserved(s:string; jolly:boolean):byte;
var posto,i:byte;    {escluso i caratteri jolly ?*}
    bad:string;
begin
bad:='|<>';   // non validi
if jolly then bad:=bad+'?*';
for i:=0 to 31 do bad:=bad+char(i);
CharReserved:=0;
for i:=1 to length(bad) do
    begin
    posto:=byte(pos(bad[i],s));
    if posto<>0 then Exit(posto);
    end;
end;

{---------------------------------------------------------------------------}

var posto,posto1:integer;
begin
if s='' then Exit(1);
if s[length(s)]='.' then Exit(length(s));

{? e * non possono stare prima dell'ultimo /}
posto:=pos('?',s);
if posto=0 then posto:=257;
posto1:=pos('*',s);
if posto1=0 then posto1:=257;
posto:=min(posto,posto1);
if posto<PosRL('/',s,255) then Exit(posto);
*)   // in base a certi criteri, tutti i caratteri possono essere ammessi, anche quelli "non"
begin
ValidNameLinux:=0;
end;

{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}

function ValidNameOS2(s:string):byte;
begin
if lfnsupport then ValidNameOS2:=ValidNameWin(s)
              else ValidNameOS2:=ValidNameDOS(s);
end;

{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}

function ValidName(s:string):byte;
begin
{$ifdef Linux}
 ValidName:=ValidNameLinux(s);
{$endif}
{$ifdef Go32v2}
 if lfnsupport then ValidName:=ValidNameWin(s)
               else ValidName:=ValidNameDOS(s);
{$endif}
{$ifdef OS2}
 if lfnsupport then ValidName:=ValidNameWin(s)
               else ValidName:=ValidNameDOS(s);
{$endif}
{$ifdef Win32}
 ValidName:=ValidNameWin(s);
{$endif}
end;

{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}

procedure Delay2(tempo:longint);      {ritardo in centesimi di secondo}
var tempo_inizio:longint;
begin
tempo_inizio:=time100;
repeat until abs(Time100-tempo_inizio)>tempo;
end;

{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}

function Char_Video:char;
{$ifdef Go32v2}
var reg:registers;
begin
reg.ah:=8;
reg.bh:=0;   {pagina}
intr($10,reg);
Char_Video:=char(reg.al);
 {   al:carattere / ah:attributi
                    4;  colore di foreground
                    3;  colore di background
                    1;  lampeggio}
{$else}
begin
Exit(#32);
{$ENDIF}
end;

{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}

function LowCase(c:char):char; {da maiuscolo a minuscolo}
begin
if c in ['A'..'Z'] then LowCase:=char(ord(c)+32)
                   else LowCase:=c;
end;

{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}

function Dim_Punto(num:int64):string;
var numero,numero1:string;
    i,pos:byte;
    negativo:boolean;
begin
pos:=0;
numero:='';
numero1:='';
if num<0 then
         begin
         negativo:=true;
         num:=-num;
         end
        else negativo:=false;
str(num,numero);
for i:=length(numero) downto 1 do
    begin
    inc(pos);
    numero1:=numero1+numero[i];
    if (pos mod 3 =0)and(pos<>length(numero)) then numero1:=numero1+ '.';
    end;
if negativo then dim_punto:='-'+fReverse(numero1)
            else dim_punto:=fReverse(numero1);
end;

{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}

function Lamp:boolean; {lampeggio: il bit nø 7 (8ø) di AH}
{$ifdef Go32v2}
var reg:registers;
begin
reg.ah:=8;
reg.bh:=0;   {pagina}
intr($10,reg);
Exit( reg.ah div 128 =1);   //  Blink=1=true
{$else}
begin
Exit(false);
{$ENDIF}
end;

{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}

function TxtColor:byte;  {foreground 0..15= i primi 4 bit di AH bit0,1,2,3}
{$ifdef Go32v2}
var reg:registers;
begin
reg.ah:=8;
reg.bh:=0;   {pagina}
intr($10,reg);
Txtcolor:=reg.ah and 15;
{$else}
begin
Exit(0);
{$ENDIF}
end;

{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}

function BackColor:byte;   {background 0..7: i bit 4,5,6 di AH (5ø,6ø,7ø) }
{$ifdef Go32v2}
var reg:registers;
begin
reg.ah:=8;
reg.bh:=0;        {pagina}
intr($10,reg);
Backcolor:=(reg.ah and 127 {127=maschera, o mod 128}) div 16;
{$else}
begin
Exit(0);
{$ENDIF}
end;

{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}

procedure RilascioDestra(var mox,moy,tasto:byte);
{$ifdef Go32v2}
var reg:registers;
begin
if MouseFound=false then
                    begin
                    mox:=0;
                    moy:=0;
                    tasto:=0;
                    Exit;
                    end;
reg.bx:=1;     {in:    bx=0: S,  bx=1: D,  bx=2: C}
reg.ax:=6;
intr($33,reg);
moy:=reg.dx div 8 +1;    {Y}
mox:=reg.cx div 8 +1;    {X}
tasto:=reg.bx;
{$else}
begin
mox:=0;
moy:=0;
tasto:=0;
{$endif}
end;

{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}

procedure Click(var mox,moy,tasto:byte);
{$ifdef Go32v2}
var reg:registers;
begin               {640 X 200 = 80*8 X 25*8}
if MouseFound=false then
                    begin
                    mox:=0;
                    moy:=0;
                    tasto:=0;
                    Exit;
                    end;
reg.ax:=3;
intr($33,reg);      {bx=1: S,  bx=2: D,  bx=4: C}
mox:=(reg.cx div 8) +1;
moy:=(reg.dx div 8) +1;
tasto:=reg.bx;
{$else}
begin
mox:=0;
moy:=0;
tasto:=0;
{$ENDIF}
end;

{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}

procedure Rilascio(var mox,moy,tasto:byte);
{$ifdef Go32v2}
var reg:registers;
begin
if MouseFound=false then
                    begin
                    mox:=0;
                    moy:=0;
                    tasto:=0;
                    Exit;
                    end;
reg.bx:=0;     {in:    bx=0: S,  bx=1: D,  bx=2: C}
reg.ax:=6;
intr($33,reg);
moy:=reg.dx div 8 +1;
mox:=reg.cx div 8 +1;
tasto:=reg.bx;  { bx=1: rilascio sinistra / bx=2: rilascio destra / bx=4: rilascio centro}
{$else}
begin
moy:=0;
mox:=0;
tasto:=0;
{$ENDIF}
end;

{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}

function fReverse(str:string):string;
var s2:string;
    l,i:byte;
begin
l:=length(str);
setlength(s2,l);
for i:=1 to L do s2[i]:=str[l-i+1];
fReverse:=s2;
end;

{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}

procedure Tast_Vuota;     {svuota il buffer della tastiera}
begin
while KeyPressed do ReadKey;
end;

{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}

{$ifdef Go32v2}
function Tasti_Speciali:byte;   {per shift,ctrl,alt...}
var reg:registers;
begin
reg.ah:=2;
intr($16,reg);
Tasti_Speciali:=reg.al;
end;
{$ENDIF}

{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}

function Shift:boolean;
{$ifdef Go32v2}
var tasti:byte;
begin
tasti:=Tasti_Speciali;
Shift:=false;
if (tasti and 1 <>0)or(tasti and 2 <>0) then Shift:=true;
{$else}
begin
exit(false);
{$ENDIF}
end;

{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}

function Exist(nome:string):int64;  {ver 1.2}
var DirInfo: TSearchRec;
begin
Exist:=-1;   {non esiste}
if (nome='')or(nome[length(nome)]='.') then Exit;
if ( Pos('*',nome)<>0 ) or (Pos('?',nome)<>0) then Exit;
if SysUtils.FindFirst(nome ,ReadOnly + Archive + Sysfile + Hidden + Anyfile, DirInfo) = 0 then Exist:=DirInfo.Size;
SysUtils.FindClose(Dirinfo);
end;

{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}

function PosRL(sub,str:string; start:byte):byte;  {cerca una stringa partendo da start da destra verso sinistra}
var i,j,pos,lsub,lstr:byte;
    pezzo:string;
begin
str:=Copy(str,1,start);
lstr:=length(str);
lsub:=length(sub);
PosRL:=0;
for i:=lstr downto lsub do
      begin
      pezzo:='';
      pos:=0;
      for j:=1 to lsub do
               begin
               pezzo:=str[i-pos]+pezzo;
               inc(pos);
               end;
      if pezzo=sub then Exit (i-lsub+1)
                   else PosRL:=0;
      end;
end;

{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}

function SostituisciLR(n:byte; sub,str,stringa:string):string;
{da sinistra verso destra, sostituisce l' n-sima stringa sub, con str nella stringa}
var posto,i:integer;
    str2:string;
begin
str2:=stringa;
posto:=0;
for i:=1 to n do
   begin
   posto:=pos(sub,str2);
   if posto=0 then Break
              else str2[posto]:=char(ord(str[1])-1); {il pos successivo sicuramente sara' diverso}
   end;
if posto<>0 then
     begin
     delete(stringa,posto,length(sub));
     insert(str,stringa,posto);
     end;
SostituisciLR:=stringa;
end;

{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}

function SostituisciRL(n:byte; sub,str,stringa:string):string;
{da destra verso sinistra, sostituisce l' n-sima stringa sub, con str nella stringa}
var posto,i:byte;
    str2:string;
begin
str2:=stringa;
posto:=0;
for i:=1 to n do
   begin
   posto:=posRL(sub,str2,length(str));
   if posto=0 then Break      {il pos successivo sicuramente sara' diverso}
              else str2[posto+length(sub)-1]:=char(ord(str[length(str)])-1);
   end;
if posto<>0 then
     begin
     delete(stringa,posto,length(sub));
     insert(str,stringa,posto);
     end;
SostituisciRL:=stringa;
end;

{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}

function Conta(str,stringa:string; start:byte; b:boolean):byte;
var count,posto,i:byte;
begin
if b then stringa:=Copy(stringa,start,length(stringa)-start+1) {a destra}
     else stringa:=Copy(stringa,1,start);                      {a sinistra}
count:=0;
for i:=1 to length(stringa)-length(str)+1 do
  begin
  posto:=byte(pos(str,stringa));
  if posto=0 then break
        else
         begin
         count:=count+1;
         stringa[posto]:=char(ord(stringa[posto])+1);
         end;
  end;
conta:=count;
end;

{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}

function CopyRL(str :string; start,count:integer):string; {copia da D verso S}
var str2:string;
    i:integer;
begin
str2:='';
for i:=1 to count do
   if (start+1-i>0)and(length(str)>start-i) then str2:=str[start+1-i]+str2
                                            else Break;
CopyRL:=str2;
end;

{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}

function TruncPath(str:string; Max:byte):string; {2.0}
var a,b:integer;
begin
str:=FExpand2(str);
a:=pos(pathdelim,str);
if (length(str)<=Max)or(a=0) then
   begin
   TruncPath:=str;
   exit;
   end;
str[a]:='?';
repeat
 b:=pos(pathdelim,str);
 if b=0 then Break
        else str[b]:='?';
 str:=copy(str,1,a)+'...'+copy_end(str,b);
until length(str)<=max;
for b:=a to length(str) do
    if str[b]='?' then str[b]:=pathdelim;
TruncPath:=str;
end;

{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}

procedure Exchange(var a,b:Int64);
var c:Int64;
begin
c:=a;
a:=b;
b:=c;
end;

{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}

procedure Exchange(var a,b:longint);
var c:longint;
begin
c:=a;
a:=b;
b:=c;
end;

{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}

procedure Exchange(var a,b:byte);
var c:byte;
begin
c:=a;
a:=b;
b:=c;
end;

{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}

function NameReserved(str:string):boolean;
var err:boolean;
    app:string;
    D: DirStr;
    N: NameStr;
    E: ExtStr;
begin
FSplit(str, D, N, E);
if length(N)>4 then Exit (false);
err:=false;
N:=UpCase(N);
str:=N;   {il nome e' in STR}
while length(str)<4 do str:=str+' '; {la qualsiasi cosa: correzione si STR}
app:=str[1]+str[2]+str[3];
repeat
 if app='COM' then if str[4] in ['1'..'4'] then err:=true;
 if err then Break;
 if app='LPT' then if str[4] in ['1'..'9'] then err:=true;
 if err then Break;
 if (N='AUX') or (N='NUL') or (N='PRN') or (N='CON') then err:=true;
until True;
NameReserved:=err;
end;

{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}

procedure Exchange(var a,b:char);
var c:char;
begin
c:=a;
a:=b;
b:=c;
end;

{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}

procedure Reverse(var str:string);
var i,L:byte;
begin
L:=length(str);
for i:=1 to (L div 2) do Exchange(str[i],str[L-i+1]);
end;

{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}

function IsInt(X: real): boolean; {Torna vero se il numero e' un intero es: 4,000000000000}
begin
if abs(X)<maxlongint then IsInt:= ( X=trunc(X) )
                     else IsInt:= false;
end;

{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}

function SIGN (R: real): real; {ritora -1 se R<0, 0 if R=0, o 1 if R>0.}
begin
if R > 0.0 then SIGN := 1.0
           else if R < 0.0 then SIGN := -1.0
                           else SIGN := 0.0;
end;

{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}

function FACT (n: integer): real;  {Ritorna il fattoriale di un numero tra 0..33, -1 altrimenti}
var k: integer;
    ans: real;
begin
  ans := 1.0;
  if (n<0)or(n>33) then FACT := -1
                   else for k := 2 to n do ans := k * ans;
  FACT := ans
end;

{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}

function DegToRad(gr:real):real;  {g:r = 360 : 2*3.14}
begin
DegToRad:=gr / 180 * Pi;
end;

{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}

function RadToDeg(rad:real):real;  {g:r = 360 : 2*3.14}
begin
RadToDeg:=rad * 180 / Pi;
end;

{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}

function fDelete(Str: String; Index,Count:Integer):string;
begin
delete(Str,Index,Count);
fDelete:=str;
end;

{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}

function Single(str:string):string; {toglie i caratteri ripetuti}
var i,ii:byte;
begin
i:=0;
repeat
 inc(i);
 ii:=i;
 while ii<length(str) do
       begin
       inc(ii);
       if str[i]=str[ii] then
              begin
              Delete(str,ii,1);
              dec(ii);
              end;
       end;
until i>=length(str);
Single:=str;
end;

{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}

function Union(s1,s2:string):string;
begin
s1:=Single(s1);
s2:=Single(s2);
if length(s1)+length(s2)<256 then Union:=Single(s1+s2)
                             else Union:=''; {se si superano i 255 caratteri}
end;

{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}

procedure Exchange(var s1,s2:string);
var s3:string;
begin
s3:=s1;
s1:=s2;
s2:=s3;
end;

{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}

function Intersection(s1,s2:string):string;
var i:byte;
    s3:string;
begin
s3:='';
s1:=Single(s1);
s2:=Single(s2);
if length(s2)<length(s1) then Exchange(s1,s2);
for i:=1 to length(s1) do if Pos(s1[i],s2)>0 then s3:=s3+s1[i];
Intersection:=s3;
end;

{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}

procedure Testa_Coda(str,ins:string; var testa,coda:string);
var pos1,pos2,tmp,i:longint;
    S:byte;
    app:string;
begin
ins:=Single(ins);
coda:='';
testa:='';
if length(str)<2 then
    begin
    testa:=str;
    Exit;
    end;
if ins='' then
   begin
   testa:=str;
   Exit;
   end;                {trovo il 1ø elemento separatore}
pos1:=maxlongint;  {il massimo}
for i:=1 to length(ins) do
    begin
    tmp:=Pos(ins[i],str);
    if tmp<>0 then pos1:=Min(pos1,tmp);
    if pos1=1 then Break; {non puo' essere < 1: inutile continuare il ciclo}
    end;
if pos1=maxlongint then S:=0  {non vi sono elementi separatori}
                   else S:=1; {c'e' almeno un elemento separatore}
if S=1 then
       begin
       pos2:=maxlongint;  {il massimo}
       app:=fDelete(str,pos1,1);
       for i:=1 to length(ins) do
           begin
           tmp:=Pos(ins[i],app);
           if tmp<>0 then pos2:=Min(pos2,tmp);
           if pos2=1 then Break; {non puo' essere < 1: inutile continuare il ciclo}
           end;
       if pos2=maxlongint then {S=1 c'e' solo un elemento separatore}
                          else
                           begin
                           S:=2; {ci sono almeno 2 elementi separatori}
                           inc(pos2);
                           end;
       end;
case S of
 0: testa:=str;
 1: if pos1=1 then testa:=str
              else
               begin
               testa:=Copy(str,1,pos1-1);
               coda:=Copy(str,pos1,length(str)-pos1+1);
               end;
 2: if pos1=1 then
               begin
               testa:=Copy(str,1,pos2-1);
               coda:=Copy(str,pos2,length(str)-pos1+1)
               end
              else
               begin
               testa:=Copy(str,1,pos1-1);
               coda:=Copy(str,pos1,length(str)-pos1+1);
               end;
 end;
end;

{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}

function Alt:boolean;
begin
{$ifdef Go32v2}
if (Tasti_Speciali and 8 <>0) then Alt:=true
                              else Alt:=false;
{$else}
exit(false)
{$endif}
end;

{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}

function Ctrl:boolean;
begin
{$ifdef Go32v2}
if (Tasti_Speciali and 4 <>0) then Ctrl:=true
                              else Ctrl:=false;
{$else}
exit(false)
{$endif}
end;

{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}

function Bool(b:longint):boolean;
begin
if b=0 then Bool:=false
       else Bool:=true;
end;

{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}

function Bool(b:boolean):byte;
begin
if b then Bool:=1
     else Bool:=0;
end;

{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}

function BoolToStr(b:boolean):string;
begin
if b then BoolToStr:='True'
     else BoolToStr:='False';
end;

{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}

function  Char_VideoXY(x,y:byte):char; {torna il carattere dove indicato}
{$ifdef Go32v2}
var a,b:byte;
begin
a:=WhereX;
b:=WhereY;
gotoxy(x,y);
Char_VideoXY:=Char_Video;
gotoxy(a,b);
{$else}
begin
Char_VideoXY:=#32;
{$endif}
end;

{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}

function  BackColorXY(x,y:byte):byte; {indica il background dove specificato}
{$ifdef Go32v2}
var a,b:byte;
begin
a:=WhereX;
b:=WhereY;
gotoxy(x,y);
BackColorXY:=BackColor;
gotoxy(a,b);
{$else}
begin
BackColorXY:=0;
{$endif}
end;

{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}

function  TxtColorXY(x,y:byte):byte;  {indica il textcolor dove specificato}
{$ifdef Go32v2}
var a,b:byte;
begin
a:=WhereX;
b:=WhereY;
gotoxy(x,y);
TxtColorXY:=TxtColor;
gotoxy(a,b);
{$else}
begin
TxtColorXY:=0;
{$endif}
end;

{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}

function  LampXY(x,y:byte):boolean;   {indica il lampeggio dove specificato}
{$ifdef Go32v2}
var a,b:byte;
begin
a:=WhereX;
b:=WhereY;
gotoxy(x,y);
LampXY:=Lamp;
gotoxy(a,b);
{$else}
begin
LampXY:=false;
{$endif}
end;

{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}

function CharReserved(s:string; jolly:boolean):byte;
var i:byte;    {escluso i caratteri jolly ?*}
    bad:string;
    risultato:boolean;
    posto:integer;
begin
bad:=',;=+ /:|<>"';
if jolly then bad:=bad+'?*';
for i:=0 to 31 do bad:=bad+char(i);
risultato:=false;
for i:=1 to length(bad) do
    begin
    posto:=pos(bad[i],s);
    if posto<>0 then
          begin
          risultato:=true;
          Break;
          end;
    end;
if risultato then CharReserved:=byte(posto)
             else CharReserved:=0;
end;

{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}

function Letters(c:char):boolean;
begin
if UpCase(c) in ['A'..'Z'] then Letters:=true
                           else Letters:=false;
end;

{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}

function Digits(c:char):boolean;
begin
if c in ['0'..'9'] then Digits:=true
                   else Digits:=false;
end;

{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}

function PosStart(sub,s:string; start:byte):byte;
var posiz:integer;
begin
posiz:=pos(sub,Copy(s,start,length(s)-start+1));
if posiz=0 then PosStart:=0
           else PosStart:=start-1+posiz;
end;

{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}

function CharDriver(s:string):char;
begin
if length(s)<2 then Exit(#0);
if s[2]<>':' then Exit(#0);
if Letters(s[1]) then Exit(UpCase(s[1]));
Exit(#0);
end;

{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}

function NumDriver(s:string):byte;
begin
if length(s)<2 then Exit(255);
if s[2]<>':' then Exit(255);
if Letters(s[1]) then Exit(ord( UpCase(s[1]) )-64);
Exit(255);
end;

{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}

function PosJolly(sub,str:string; start:byte):byte;
var position,stringa:string;
    cicli:byte;
    a:integer;
begin
str:=Copy(str,start,length(str)-start+1);
position:='';
for a:=1 to length(sub) do if sub[a]='?' then position:=position+char(a);

cicli:=0;
while true do
      begin
      inc(cicli);
      stringa:=Copy(str,cicli,length(str)-cicli+1); {copia la parte interessata}
      for a:=1 to length(position) do  {modifica dove necessario}
          if a<=length(str) then stringa[ord(position[a])]:='?'
                            else Break;
      a:=pos(sub,stringa);
      if a>0 then Exit(start-1+a+cicli-1)
             else if cicli>=length(str)-length(sub)+1 then Exit(0);
      end;
end;

{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}

function PosJollyRL(sub,str:string; start:byte):byte;
var position,stringa:string;
    a,cicli:byte;
begin
str:=Copy(str,1,start);
position:='';
for a:=1 to length(sub) do if sub[a]='?' then position:=position+char(a);
cicli:=length(sub)-1;
while true do
      begin
      inc(cicli);
      stringa:=Copy(str,length(str)-cicli+1,cicli); {copia la parte interessata}
      for a:=1 to length(position) do  {modifica dove necessario}
          if a<=length(str) then stringa[ord(position[a])]:='?'
                            else Break;
      a:=posRL(sub,stringa,length(stringa));
      if a>0 then Exit (length(str)-length(stringa)+1)
             else if cicli>length(stringa) then Exit(0);
      end;
end;

{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}

function DirEmpty(s:string):boolean;
var vuota:boolean;
    DirInfo: SearchRec;
begin
if s='' then s:={$ifdef Linux}'*'{$else}'*.*'{$endif}
        else
         case s[length(s)] of
                 pathdelim : s:=s+{$ifdef Linux}'*'{$else}'*.*'{$endif};
                       ':' : s:=s+{$ifdef Linux}'*'{$else}'*.*'{$endif};
                        else s:=s+pathdelim+{$ifdef Linux}'*'{$else}'*.*'{$endif};
              end;
vuota:=true;
FindFirst(s, Archive + ReadOnly + Directory + Hidden + SysFile + AnyFile, DirInfo);
while (DosError=0) and vuota do
      begin
      if (dirinfo.Name<>'.')and(dirinfo.Name<>'..') then vuota:=false;
      FindNext(DirInfo);
      end;
DirEmpty:=vuota;
end;

{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}

function isDir(s:string):boolean;
var F: file;
    Attr: Word;
begin
isDir:=false;
if (pos('\\',copy(s,2,255))<>0) or (s='\\') then Exit;
Assign(F, s);
GetFAttr(F, Attr);
if DosError = 0 then
   if Attr and directory <> 0 then Exit(true);
if (s<>'')and(s[length(s)]=pathdelim) then
   begin
   s:=copy(s,1,length(s)-1);
   Assign(F, s);
   GetFAttr(F, Attr);
   if DosError = 0 then
      if Attr and directory <> 0 then Exit(true);
   end;
end;

{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}

function StringToPChar(s:string):PChar;
begin
StrPCopy(StringToPchar_, s);
StringToPChar:=StringToPchar_;
end;

{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}

function FreeChar(c,s:string):string;
var i,j:byte;
    ris:string;
begin
for i:=1 to length(c) do
      begin
      ris:='';
      for j:=1 to length(s) do if c[i]<>s[j] then ris:=ris+s[j];
      s:=ris;
      end;
FreeChar:=s;
end;

{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}

function PathOf(stringa:string):string;
var D: DirStr;
    N: NameStr;
    E: ExtStr;
begin
FSplit(stringa, D, N, E);
pathof:=D;
end;

{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}

function NameOf(s:string):string;
var D: DirStr;
    N: NameStr;
    E: ExtStr;
begin
FSplit(s, D, N, E);
NameOf:=n+e;
end;

{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}

function NameOf_No_Ext(s:string):string;
var D: DirStr;
    N: NameStr;
    E: ExtStr;
begin
FSplit(s, D, N, E);
NameOf_No_Ext:=n;
end;

{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}

function ValidNameDOS(s:string):byte;
var testa,coda:string;
    D: DirStr;
    N: NameStr;
    E: ExtStr;
    posto,posto1:integer;
begin
testa:=s;
if testa='' then Exit(1);
if testa[length(testa)]='.' then Exit(length(testa));

                               {controllo se il ':' e' valido}
if copy(testa,1,2)='\\' then        { net }
                         begin
                         if pos(':',testa)<>0 then exit(pos(':',testa));
                         end
                        else
                         begin
                         posto:=CharReserved(testa[1]+Copy(testa,3,255),false);
                         if posto>1 then inc(posto);
                         if posto<>0 then Exit(posto);
                         end;
{? e * non possono stare prima dell'ultimo \}
posto:=pos('?',testa);
if posto=0 then posto:=257;
posto1:=pos('*',testa);
if posto1=0 then posto1:=257;
posto:=min(posto,posto1);
if posto<PosRL('\',testa,255) then Exit(posto);
if Copy(testa,2,1)=':' then      {controllo se il ':' e' valido}
   begin
   if Letters(testa[1])=false then Exit(1);
   testa:=Copy(testa,3,255);
   end;

posto:=pos('\\',copy(testa,2,255));
if posto>0 then Exit(posto);
posto:=pos('...',testa);
if posto>0 then Exit(posto);

if copy(testa,1,2)='\\' then testa[1]:='A'; { \\... deve divetare valido, ad esempio A\... }
while (testa<>'') do
          begin
          Testa_Coda(testa,'\',testa,coda);
          if (testa[1]='\')and(testa<>'\') then testa:=Copy(testa,2,255);
          if testa='..' then
                        begin
                        testa:=coda;
                        Continue;
                        end;
          posto:=Conta('.',testa,1,true);
          if posto>1 then
             begin
             testa[pos('.',testa)]:='X';
             Exit(pos('.',testa));
             end;
          if (testa='')or NameReserved(testa) then
             Exit(Length(s)-length(coda)+1-length(testa));
          FSplit(testa, D, N, E);
          if (length(n)>8) or (length(e)>4) then {controllo lunghezza nome.est}
             Exit(Length(s)-length(coda)+1-length(testa));
          testa:=coda;
          end;

ValidNameDOS:=0;
end;

{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}

function NewDir(dir:string):integer;
var coda,thispath:string;
    creato,first:boolean;
    i:byte;
begin
i:=ValidName(dir);
if i>0 then Exit (i);
first:=true;
creato:=false;
GetDir(0,thispath);  {lo salvo per rispristinarlo dopo}

{$ifndef Linux}
if length(dir)>1 then if dir[2]=':' then
   begin
   {$i-}
   ChDir(dir[1]+dir[2]);
   {$i+}
   if IOResult=0 then dir:=copy_end(dir,3)
                 else
                  begin
                  {$I-}
                  chdir(thispath);
                  {$I+}
                  if IOResult<>0 then ;
                  Exit(-1);  { *** Unita' specificata non valida}
                  end;
   end;
{$endif}

while (dir<>'') do
      begin
      Testa_Coda(dir,pathdelim,dir,coda);
      if first then first:=false
               else dir:=copy(dir,2,255);
      if dir='.' then
                 begin
                 dir:=coda;
                 continue;
                 end;
      {$i-}
      ChDir(dir);
      {$i+}
      if IOResult<>0 then
                     begin
                     if dir='..' then
                                 begin
                                 {$I-}
                                 chdir(thispath);
                                 {$I+}
                                 if IOResult<>0 then ;
                                 Exit(-2); { *** Percorso inesistente }
                                 end;
                     {$I-}
                     MkDir(dir);
                     {$I+}
                     if IOResult=0 then creato:=true else;
                     {$i-}
                     ChDir(dir);
                     {$i+}
                     if IOResult<>0 then
                                 begin
                                 {$I-}
                                 chdir(thispath);
                                 {$I+}
                                 if IOResult<>0 then ;
                                 Exit(-3);    { *** Accesso negato }
                                 end;
                     end;
      dir:=coda;
      end;   {while}
if creato then NewDir:=0   { *** Directory Creata }
          else NewDir:=-4; { *** La directory esiste gia' }
{$I-}
chdir(thispath);
{$I+}
if IOResult<>0 then ;
end;

{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}

function TmpFile(ilFile:string):string;
var tt1:string;

function TMP(t1:string):string;  {sottofunzione di TmpFile}
var p2,nome,estensione,risultato:string;
    valore:longint;
    punto:integer;
label riprova;

begin
valore:=-1;
if isDir(T1) then
   begin
   if t1[length(t1)]<>pathdelim then t1:=t1+pathdelim;
   p2:=t1;
   t1:=t1+ilFile;
   if Exist(t1)=-1 then Exit(t1) {non esiste}
                  else   {esiste, devo cambiare nome}
                   begin
                   t1:=p2;
      riprova:     inc(valore);
                   if valore>=maxlongint then Exit('');
                   p2:=IntToStr(valore);
                   punto:=pos('.',ilFile);
                   if punto=0 then estensione:=''
                              else estensione:=Copy(ilFile,punto+1,3);
                   if punto=0 then nome:=ilFile
                              else nome:=Copy(ilFile,1,pos('.',ilFile)-1);
                   while length(nome)<8 do nome:=nome+'0';
                   nome:=Copy(nome,1,8-length(p2))+p2;
                   if estensione<>'' then risultato:=t1+nome+'.'+estensione
                                     else risultato:=t1+nome;
                   if Exist(risultato)=-1 then Exit(risultato)
                                          else goto riprova;
                   end;
   end
  else if NewDir(t1)=0 then
   begin
   if t1[length(t1)]<>pathdelim then t1:=t1+pathdelim;
   Exit(t1+ilFile);
   end;
end;

begin    {codice di TmpFile}
tt1:='';
if (ilFile<>NameOf(ilFile))or(ValidName(ilFile)>0)or(pos('*',ilFile)<>0)or(pos('?',ilFile)<>0) then
   Exit('');

if tt1='' then tt1:=TMP(GetEnv('TMP'));
if tt1='' then tt1:=TMP(GetEnv('TEMP'));
if tt1='' then
          begin
          GetDir(0,tt1);
          if tt1[length(tt1)]<>pathdelim then tt1:=tt1+pathdelim;
          tt1:=TMP(tt1);
          end;
TmpFile:=tt1;
end;

{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}

function SubDir(path,tmpfiles:string):byte;
var  DirInfo: SearchRec;
     tmp: file of string;
     stringa,old_s:string;
     p_inizio:longint;

begin
assign(tmp,tmpfiles);
{$i-}
rewrite(tmp);
{$i+}
if IOResult<>0 then Exit(1);

if (path<>'')and(not (path[length(path)] in [pathdelim,':']) ) then path:=path+pathdelim;
p_inizio:=0;
FindFirst(path+{$ifdef Linux}'*'{$else}'*.*'{$endif}, ReadOnly+Hidden+SysFile+Directory+Archive, DirInfo);
while DosError = 0 do
      begin
      if (dirinfo.attr and directory) =0 then
         begin
         FindNext(DirInfo);
         Continue;
         end;
      if (dirinfo.name='.')or(dirinfo.name='..') then
         begin
         FindNext(DirInfo);
         Continue;
         end;
      if (path<>'')and(not (path[length(path)] in [pathdelim,':']) ) then path:=path+pathdelim;
      stringa:=path+DirInfo.Name;
      {***SOLO PER DISGNOSTICA}
      while length(stringa)<255 do stringa:=stringa+#0;
      {$i-}
      Write(tmp,stringa);
      {$i+}
      if IOResult<>0 then exit(1);
      FindNext(DirInfo);
      end;

while true do
      begin
      if KeyPressed then
            case readkey of
              #27: Exit (2);
              #00: ReadKey;
            end;
      {$i-}
      Seek(tmp,p_inizio);
      {$i+}
      if IOResult<>0 then Exit (1);
      if EOF(tmp) then Break;
      inc(p_inizio);
      {$i-}
      read(tmp,stringa);
      {$i+}
      if IOResult<>0 then Exit(1);
      {***SOLO PER DISGNOSTICA}
      stringa:=FreeChar(#0,stringa);
      if (stringa<>'')and(not (stringa[length(stringa)] in [pathdelim,':']) ) then stringa:=stringa+pathdelim;
      old_s:=stringa;
      FindFirst(stringa+{$ifdef Linux}'*'{$else}'*.*'{$endif}, ReadOnly+Hidden+SysFile+Directory+Archive, DirInfo);
      while DosError = 0 do
            begin
            if (dirinfo.attr and directory)=0 then
               begin
               FindNext(DirInfo);
               Continue;
               end;
            if (dirinfo.name='.')or(dirinfo.name='..') then
               begin
               FindNext(DirInfo);
               Continue;
               end;
            if (stringa<>'')and(not (stringa[length(stringa)] in [pathdelim,':']) ) then stringa:=stringa+pathdelim;
            stringa:=old_s+DirInfo.Name;
            {***SOLO PER DISGNOSTICA}
            while length(stringa)<255 do stringa:=stringa+#0;
            Seek(tmp,(FileSize(tmp)));
            {$i-}
            Write(tmp,stringa);
            {$i+}
            if IOResult<>0 then Exit(1);
            FindNext(DirInfo);
            end;
      end;
{$i-}
Close(tmp);
{$i+}
if IOResult<>0 then Exit(1);
subdir:=0;
end;

{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}

function espansione(s:string; e:boolean):string;
var old,new_str:string;
    p1,p2:longint;
begin
old:=s;
repeat
 p1:=pos('%',s);
 if p1=0 then break;
 p2:=pos('%',copy_end(s,p1+1));
 p2:=p2+p1;
 if p1=p2 then break;
 new_str:=GetEnv(copy(s,p1+1,p2-p1-1));
 if new_str='' then break;
 s:=copy(s,1,p1-1)+new_str+copy_end(s,p2+1);
until false;
if pos('%',s)=0 then
                 if e then  { net }
                        if copy(s,1,2)='\\' then espansione:=copy_end(fexpand(s),pos('\\',fexpand(s)))
                                            else espansione:=fexpand(s)
                      else espansione:=s
                else espansione:=old; { numero di '%' dispari: errore }
end;

{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}

function ExpandEnvironment(s:string):string;
begin
{$ifndef Linux}
exit(espansione(s,false));
{$else}
exit(fexpand(s));
{$endif}
end;

{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}

function FExpand2(s:string):string;
begin
{$ifndef Linux}
exit(espansione(s,true));
{$else}
exit(fexpand(s));
{$endif}
end;

{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}

function GetTextMaxX:word;
var x,y:byte;
    x_,old_x:integer;
begin
x:=whereX;
y:=whereY;
old_x:=0;
x_:=1;
repeat
 if x_>=255 then Exit(255);
 gotoxy(byte(x_),1);
 old_x:=x_;
 inc(x_);
until wherex<>old_x;
GetTextMaxX:=wherex;
gotoxy(x,y);
end;

{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}

function GetTextMaxY:word;
var x,y:byte;
    y_,old_y:integer;
begin
x:=whereX;
y:=whereY;
old_y:=0;
y_:=1;
repeat
 if y_>=255 then Exit(255);
 gotoxy(1,byte(y_));
 old_y:=y_;
 inc(y_);
until wherey<>old_y;
GetTextMaxy:=wherey;
gotoxy(x,y);
end;

{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}

procedure Eleva(base,esponente:real; var potenza:real; var err:byte);
begin             { b^x = e^( Ln (b^x) ) = e^( x Ln b ) }
if base=0 then Err:=1;            {Valori per Err:             }
if base>0 then                                { 1:   Base = 0     }
     begin                                    { 2:   Esponente <0 }
     if esponente<0 then err:=2;              { 3:   Base <0 , Esponente >0 }
     potenza:=real(exp(esponente*ln(base)));  { 4:   Base <0 , Esponente <0 }
     end;
if (base<0) and (esponente>0) then err:=3;
if (base<0) and (esponente<0) then err:=4;
end;

{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}

function ToDecimal(num:string; oldBase:byte):string; {converte da base 2..16 a decimale}
var i,cifra,err:byte;
    neg:boolean;
    old,valore,cont:longint;
    risult:real;
begin
if (oldBase>16)or(oldBase<2)or(num='') then
      begin
      ToDecimal:='';
      Exit;
      end;
valore:=0;
cont:=-1;
if num[1]='-' then
    begin
    neg:=true;
    delete(num,1,1);
    end
   else neg:=false;

for i:=length(num) downto 1 do
begin
 inc(cont);
 if num[i] in ['0'..'9'] then cifra:=ord(num[i])-48
    else
     case UpCase(num[i]) of
        'A': cifra:=10;
        'B': cifra:=11;
        'C': cifra:=12;
        'D': cifra:=13;
        'E': cifra:=14;
        'F': cifra:=15;
        end;
if cifra>oldBase then
      begin
      ToDecimal:='';
      Exit;
      end
     else
      begin
      Eleva(oldBase,cont,risult,err);
      old:=valore;
      Valore:=valore+cifra*Trunc(risult);
      if valore<old then
          begin
          ToDecimal:='';  {sforato il max longint}
          Exit;
          end;
      end;
end;
if neg then valore:=-valore;
ToDecimal:=IntToStr(valore);
end;

{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}

function DecimalTo(numdec:longint; newBase:byte):string;
var s:string;           {converte da decimale a base 2..16 (maiuscolo)}
    v:byte;             {se la base e' errata torna stringa vuota}
    c:char;
    neg:boolean;
begin
if (newBase>16)or(newBase<2) then
      begin
      DecimalTo:='';
      Exit;
      end;
s:='';
if numdec<0 then
    begin
    neg:=true;
    numdec:=-numdec;
    end
   else neg:=false;
repeat
 v:=numdec mod newBase;
 numdec:=numdec div newBase;
 case v of
   10: c:='A';
   11: c:='B';
   12: c:='C';
   13: c:='D';
   14: c:='E';
   15: c:='F';
   else c:=char(v+48);
 end;
 s:=c+s;
until numdec=0;
if neg then s:='-'+s;
DecimalTo:=s;
end;

{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}

function FromTo(oldV:string; oldB,newB:byte):string;{newV} {converte da base a base (2..16)}
var num:longint;
    err:integer;
begin
oldV:=ToDecimal(oldV,oldB); {converte da base 2..16 a decimale}
if oldV<>'' then {no errori nella riga precedente durante la conversione}
   begin
   Val(oldV,num,err);
   FromTo:=DecimalTo(num,newB);
   end
  else FromTo:='';
end;

{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}

function contaDirFile(s:string):longint;
var DirInfo: SearchRec;
    tot:longint;

begin
s:=fexpand2(s);
if isDir(s)=false then
                  begin
                  contaDirFile:=-1;
                  Exit;
                  end;
if s[length(s)]<>pathdelim then s:=s+pathdelim;
s:=s+{$ifdef Linux}'*'{$else}'*.*'{$endif};
tot:=0;
FindFirst(s, Archive + ReadOnly + SysFile + Hidden + Directory + Anyfile, DirInfo);
while DosError = 0 do
      begin
      if (dirinfo.name<>'.')and(dirinfo.name<>'..') then inc(tot);
      FindNext(DirInfo);
      end;
contadirfile:=tot;
end;

{++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}

function contaDir(s:string):longint;
var DirInfo: SearchRec;
    tot:longint;

begin
s:=fexpand2(s);
if isDir(s)=false then
                  begin
                  contadir:=-1;
                  Exit;
                  end;
if s[length(s)]<>pathdelim then s:=s+pathdelim;
s:=s+{$ifdef Linux}'*'{$else}'*.*'{$endif};
tot:=0;
FindFirst(s, Archive + ReadOnly + SysFile + Hidden + Directory + Anyfile, DirInfo);
while DosError = 0 do
      begin
      if (dirinfo.name<>'.')and(dirinfo.name<>'..')and(dirinfo.attr and directory <>0) then inc(tot);
      FindNext(DirInfo);
      end;
contadir:=tot;
end;

{++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}

function contaFile(s:string):longint;
var DirInfo: SearchRec;
    tot:longint;

begin
s:=fexpand2(s);
if isDir(s)=false then
                  begin
                  contafile:=-1;
                  Exit;
                  end;
if s[length(s)]<>pathdelim then s:=s+pathdelim;
s:=s+{$ifdef Linux}'*'{$else}'*.*'{$endif};
tot:=0;
FindFirst(s, Archive + ReadOnly + SysFile + Hidden + Directory + Anyfile, DirInfo);
while DosError = 0 do
      begin
      if (dirinfo.name<>'.')and(dirinfo.name<>'..')and(dirinfo.attr and directory =0) then inc(tot);
      FindNext(DirInfo);
      end;
contaFile:=tot;
end;

{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}

function contaThis(path,nome:string):longint;
var DirInfo: SearchRec;
    tot:longint;
begin
path:=fexpand2(path);
if isDir(path)=false then
                  begin
                  contaThis:=-1;
                  Exit;
                  end;
if path[length(path)]<>pathdelim then path:=path+pathdelim;
path:=path+nome;
tot:=0;
FindFirst(path, Archive + ReadOnly + SysFile + Hidden + Directory + Anyfile, DirInfo);
while DosError = 0 do
      begin
      if (dirinfo.name<>'.')and(dirinfo.name<>'..') then inc(tot);
      FindNext(DirInfo);
      end;
contathis:=tot;
end;

{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}

function Attr(s:string):string;
var F: SearchRec;
begin
if s='' then exit('');
if s[length(s)]=pathdelim then s:=copy(s,1,length(s)-1);
FindFirst(s, Anyfile, F);
if (doserror<>0) then Exit('');
s:='';
if (f.attr and archive)  <>0 then s:='A'     else s:='_';
if (f.attr and readonly) <>0 then s:=s+'R' else s:=s+'_';
if (f.attr and hidden)   <>0 then s:=s+'H' else s:=s+'_';
if (f.attr and sysfile)  <>0 then s:=s+'S' else s:=s+'_';
if (f.attr and directory)<>0 then s:=s+'D' else s:=s+'_';
attr:=s;
end;

{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}

function UpStr(c:string):string;
begin
Exit(upcase(c));
end;

{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}

{$IFDEF Linux}
function getshortname(var s:shortstring):boolean;
begin
exit(true);
end;
{$ENDIF}

{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}

{$IFDEF OS2}
function getshortname(var s:shortstring):boolean;
begin
exit(true);
end;
{$ENDIF}

{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}

{$IFDEF Linux}
function getlongname(var s:shortstring):boolean;
begin
exit(true);
end;
{$ENDIF}

{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}

{$IFDEF OS2}
function getlongname(var s:shortstring):boolean;
begin
exit(true);
end;
{$ENDIF}

{++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}

function from_alt_to_char(b:byte):char;
begin
case b of
     16 : from_alt_to_char:='q';
     17 : from_alt_to_char:='w';
     18 : from_alt_to_char:='e';
     19 : from_alt_to_char:='r';
     20 : from_alt_to_char:='t';
     21 : from_alt_to_char:='y';
     22 : from_alt_to_char:='u';
     23 : from_alt_to_char:='i';
     24 : from_alt_to_char:='o';
     25 : from_alt_to_char:='p';

     30 : from_alt_to_char:='a';
     31 : from_alt_to_char:='s';
     32 : from_alt_to_char:='d';
     33 : from_alt_to_char:='f';
     34 : from_alt_to_char:='g';
     35 : from_alt_to_char:='h';
     36 : from_alt_to_char:='j';
     37 : from_alt_to_char:='k';
     38 : from_alt_to_char:='l';

     44 : from_alt_to_char:='z';
     45 : from_alt_to_char:='x';
     46 : from_alt_to_char:='c';
     47 : from_alt_to_char:='v';
     48 : from_alt_to_char:='b';
     49 : from_alt_to_char:='n';
     50 : from_alt_to_char:='m';

     120..128 : from_alt_to_char:=char(b-120+49);
     129 : from_alt_to_char:='0';
     else from_alt_to_char:=#1;
     end;
end;

{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}

function Intersezione(y11,y12,y21,y22:longint):boolean;
begin
if y11>y12 then Exchange(y11,y12);
if y21>y22 then Exchange(y21,y22);
if y11>y22 then
   begin
   Exchange(y21,y12);
   Exchange(y11,y22);
   end;
Exit( not (y12<y21) );
end;

{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}

procedure Intersezione_tra(y11,y12,y21,y22:int64; var a,b:int64);
begin
if y11>y12 then Exchange(y11,y12);
if y21>y22 then Exchange(y21,y22);
if y12<y21 then
    begin
    a:=1;
    b:=0;
    end
   else
    begin
    a:=max(y11,y21);
    b:=min(y12,y22);
    end;
end;

{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}

function Lunghezza_Intersezione(y11,y12,y21,y22:int64):int64;
var a,b:int64;
begin
Intersezione_tra(y11,y12,y21,y22,a,b);
Exit(max(b-a+1,0));
end;

{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}

function str_is_int(s:string):boolean;
var code:word;
    n:longint;
begin
val(s,n,code);
n:=n+1; // solo per evitare che vi sia avviso di variabile solo assegnata
str_is_int:=code=0;
end;

{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}

function from_alt_to_char(s:String):char;
var p:longint;
    shift:boolean;
begin
p:=pos('SHIFT ',s);
shift:=(p>0);
if p>0 then delete(s,p,6);
p:=pos('CTRL ',s);
if p>0 then delete(s,p,5);
p:=pos('ALT Key with scancode ',s);
if p>0 then delete(s,p,22);
from_alt_to_char:=#0;
if s='4096' then exit('Q');
if s='4352' then exit('W');
if s='4608' then exit('E');
if s='4864' then exit('R');
if s='5120' then exit('T');
if s='5376' then exit('Y');
if s='5632' then exit('U');
if s='5888' then exit('I');
if s='6144' then exit('O');
if s='6400' then exit('P');

if s='7680' then exit('A');
if s='7936' then exit('S');
if s='8192' then exit('D');
if s='8448' then exit('F');
if s='8704' then exit('G');
if s='8960' then exit('H');
if s='9216' then exit('J');
if s='9472' then exit('K');
if s='9728' then exit('L');

if s='11264' then exit('Z');
if s='11520' then exit('X');
if s='11776' then exit('C');
if s='12032' then exit('V');
if s='12288' then exit('B');
if s='12544' then exit('N');
if s='12800' then exit('M');

if s='30720' then
              if shift then exit('!')
                       else exit('1');
if s='30976' then
              if shift then exit('"')
                       else exit('2');
if s='31232' then
              if shift then exit('œ')
                       else exit('3');
if s='31488' then
              if shift then exit('$')
                       else exit('4');
if s='31744' then
              if shift then exit('%')
                       else exit('5');
if s='32000' then
              if shift then exit('&')
                       else exit('6');
if s='32256' then
              if shift then exit('/')
                       else exit('7');
if s='32512' then
              if shift then exit('(')
                       else exit('8');
if s='32768' then
              if shift then exit(')')
                       else exit('9');
if s='33024' then
              if shift then exit('=')
                       else exit('0');
end;

{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}

function lettere_unita_():string;
const lettere:string={$ifdef Go32v2}'AB'{$else}''{$endif};
var DirInfo: SearchRec;
    i:char;
    lettere2:string;
begin
if lettere='' then
    for i:={$ifdef Go32v2}'C'{$else}'A'{$endif} to 'Z' do
        begin
        dos.FindFirst(i+':\*.*', Archive, DirInfo);
        if doserror<>3 then lettere:=lettere+i;
        dos.FindClose(DirInfo);
        end
   else
    begin
    lettere2:='';
    if pos('A',lettere)>0 then lettere2:=lettere2+'A';
    if pos('B',lettere)>0 then lettere2:=lettere2+'B';
    for i:='C' to 'Z' do
        begin
        dos.FindFirst(i+':\*.*', Archive, DirInfo);
        if doserror<>3 then lettere2:=lettere2+i;
        dos.FindClose(DirInfo);
        end;
    lettere:=lettere2;
    end;
lettere_unita_:=lettere;
end;

{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}

function lettere_unita():string;   // GetLogicalDriveString
begin
{$ifdef Linux}
 lettere_unita:='';
{$else}
 lettere_unita:=lettere_unita_();
{$endif}
end;

{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}

function copy_end(s:string; origine:longint):string;
begin  // copia dall'origine fino alla fine della stringa
copy_end:=copy(s,origine,length(s));
end;

{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}

procedure Val_Try(Stringa:string; var n:Int64; var pos_err:word);
begin
pos_err:=0;
n:=StrToInt64Def(Stringa,-1{predefinito in caso di errore});
if n<0 then pos_err:=1;
end;

{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}

procedure Val_Try(Stringa:string; var n:longint; var pos_err:word);
begin
pos_err:=0;
Try
 n:=StrToInt(stringa);
 except On  E  :  EConvertError  do pos_err:=1;
 end;
end;

{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}

procedure Val_Try(S:string; var n:real; var pos_error:word);
begin
pos_error:=0;
Try
 n:=StrToInt(s);
 except On  E  :  EConvertError  do pos_error:=1;
 end;
end;

{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
(*
procedure StrToInt(str:string; var v:int64; var pos_err:integer);
var negativo:boolean;
    i:integer;
begin
pos_err:=0;
v:=0;
if length(str)=0 then pos_err:=1
                 else
                  begin
                  negativo:=(str[1]='-');
                  if str[1] in ['+','-'] then
                     begin
                     str:=copy_end(str,2);
                     if length(str)=0 then
                                      begin
                                      pos_err:=1;
                                      exit;
                                      end;
                     end;
                  for i:=1 to length(str) do
                      if not(str[i] in ['0'..'9']) then
                            begin
                            pos_err:=i+Bool(negativo);
                            exit;
                            end;
                  v:=SysUtils.StrToInt(str);
                  if negativo then v:=v*(-1);
                  end;
end;
*)
{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}

end.


Versione:    Data:     Righe:  Modifica:

1. ? .010  20/01/03    2562    con Intersezioni;
1. ? .009  19/12/02    2562    con From_alt_to_char;
1. ? .008  29/09/02    2435    con Conta dir_file;
1. ? .007  25/08/02    2345    con WindowsXXX per la unit Video;
1. ? .006  26/07/02    2038    fine Get e Set per la unit Video;
1. ? .005  16/07/02    1784    Get e Set per la unit Video;
1. ? .004  10/03/02    1577    GetTextMaxX , GetTextMaxY;
1. ? .003  28/02/02    1534    FExpand2;
1. ? .002  18/10/01    1467    IfDef;
1.085.001  02/04/01    1456    inizio.

 upstr / lowstr = upcase / lowercase
 nospaceL/R     = TrimL/R
 compare_mouse  = showmouse
 scompare_mouse = hidemouse
 destroyf       = deletefile
