{$IFDEF WtrGate}{$IFDEF UseOvr}{$O+,F+}{$ENDIF}{$ENDIF}
UNIT Binkley;

{$i platform.inc}

{ Fido Binkley Outbound Routines }

{ History:

MD   27-02-93 Eerste versie gemaakt.
RvdW 21-05-93 Opgepoetst en waar mogelijk en nodig geoptimaliseerd.
MD   25-06-93 Opnieuw ingeplugt, dit als uitbreiding van de FidoPack
              routine. BinkCreateOUTFile overgenomen uit FidoPack
              MoveFile hier ook maar geplaatst, er was geen speciale
              file voor.
MD   26-06-93 Toevoegen van SendFormat (*.HLO,*.CLO,*.DLO,*.FLO)
              aan BinkCreateOUTFile
     21-10-93 Veranderen van Movefile in een rename operatie om veel
              diskaccess te besparen.
}

{ unsolved:
RvdW 21-05-93 CheckDomain gaat er vanuit dat de config domain namen in
              hoofdletters staan. Is dat wel juist? Volgens mij kunnen er
              ook kleine letters in komen te staan. Twee oplossingen:
              UpCaseString of force-capitals (@) in het configinvoerveld.
MD            Ik denk dat we domain namen moeten negeren.... de meeste
              software ondersteund ze niet of maar half, het staat leuk
              maar dat is ook alles.
}

INTERFACE

USES Ramon,
     Fido,
     Msgs,
     Database,
     UserBase,
     Routing;

FUNCTION  BinkleyOutbound (Adres : FidoAddrType) : STRING;
FUNCTION  BinkFidoAdres (Net,Node : WORD) : STRING;
FUNCTION  BinkCreateOUTfile (KillType : STRING; Directory, FileName : STRING;
                             Address : FidoAddrType; SendFormat : SendType) : BOOLEAN;
PROCEDURE BinkOutFile_AddAttaches (DoKFS: Boolean; Subject : STRING; Address : FidoAddrType; SendFormat : SendType);
PROCEDURE BinkCreateREQFile (Address : FidoAddrType; FileName : STRING);
FUNCTION  BinkCheckBusy (Directory : STRING; Address : FidoAddrType): BOOLEAN;
PROCEDURE BinkClearBusy (Directory : STRING; Address : FidoAddrType);
FUNCTION  MoveFile (Source,Destination : STRING) : BOOLEAN;
FUNCTION  MoveFileWithDirectory (Source,Destination : STRING) : BOOLEAN;


IMPLEMENTATION

USES Globals,
     Dos,
     Cfg,
     Logs;

{--------------------------------------------------------------------------}
{ StripLastDirectory                                                       }
{                                                                          }
{ Haalt het laatste gedeelte van een directory af, zodat die hergebruikt   }
{ kan worden voor andere netwerk domains. Het terug gegeven argument HEEFT }
{ AL een backslash aan het einde!                                          }
{                                                                          }
{ RWI 950521: Als het laatste teken van het argument een backslash is, dan }
{             wordt die eerst verwijderd.                                  }
{                                                                          }
{ C:\WG\OUTBOUND  -> C:\WG\                                                }
{ C:\WG\OUTBOUND\ -> C:\WG\                                                }
{ C:\OUTBOUND     -> C:\                                                   }
{ C:OUTBOUND      -> C:                                                    }
{ C:OUTBOUND\     -> C:                                                    }
{ ..\OUTBOUND     -> ..\                                                   }
{ C:\             -> C:\  + warning                                        }
{ C:              -> C:   + warning                                        }
{ ..              -> ..\  + warning                                        }
{                                                                          }
FUNCTION StripLastDirectory (Invoer : STRING) : STRING;

VAR Positie,Lp : BYTE;

BEGIN
     { als het laatste teken een backslash is en het is niet een root }
     { indicatie, verwijder dat teken dan.                            }
     IF ((Invoer[Length (Invoer)] = '\') AND (Invoer[Length (Invoer)-1] = ':')) OR
        (Invoer = '..') OR (Invoer = '..\') OR (Invoer[Length (Invoer)] = ':') THEN
     BEGIN
          { nothing to be done about this one }
          LogMessage (liGeneral,'Cannot strip last directory from '+Invoer);
          StripLastDirectory:=Invoer;
          Exit;
     END;

     IF (Invoer[Length (Invoer)] = '\') THEN
        Delete (Invoer,Length (Invoer),1);

     { nog geen backslash gevonden }
     Positie:=0;

     { zoek de laatste backslash in het pad op. Het root teken mag ook }
     FOR Lp:=1 TO Length (Invoer) DO
         IF (Invoer[Lp] IN ['\',':']) THEN
            Positie:=Lp;

     { als de laatste backslash gevonden is, hak dat laatste directory }
     { deel er dan vanaf.                                              }
     IF (Positie > 0) THEN
        Invoer:=Copy (Invoer,1,Positie)
     ELSE
         LogMessage (liGeneral,'Cannot strip last directory from '+Invoer);

     IF (Invoer[Length (Invoer)] <> '\') THEN
        Invoer:=Invoer+'\';

     { en geef het restant terug }
     StripLastDirectory:=Invoer;
END;


(*
{--------------------------------------------------------------------------}
{ CheckDomain                                                              }
{                                                                          }
{ Kijkt of het adres voorzien is van een geldige domain naam. Als dit niet }
{ zo is, dan wordt de domain naam van het main aka erachter gezet.         }
{                                                                          }
PROCEDURE CheckDomain (VAR Adres : FidoAddrType);

VAR Tel_Aka   : 1..MaxAkas;
    Found_Aka : BOOLEAN;

BEGIN
     { controleer of het genoemde Domain een geldige is }

     Adres.Domain:=UpCaseString (Adres.Domain);
     Found_Aka:=FALSE;

     IF (Adres.Domain <> '') THEN
        FOR Tel_Aka:=1 TO MaxAkas DO
            IF (Adres.Domain = UpCaseString (Config.NodeNrs[Tel_Aka].Domain)) THEN
            BEGIN
                 Found_Aka:=TRUE;
                 Break; { uit de for }
            END;

     { als het geen bekende Domain naam is, ga er dan vanuit dat }
     { het in ons hoofd domain ligt.                             }
     IF (NOT Found_Aka) THEN
        Adres.Domain:=Config.NodeNrs[1].Domain;
END;
*)


{--------------------------------------------------------------------------}
{ FidoBinkAdres                                                            }
{                                                                          }
{ Converteer een Net/Node combinatie naar een hexadecimale string:         }
{ 512/17 zou worden : 02000011                                             }
{                                                                          }
FUNCTION BinkFidoAdres (Net,Node : WORD) : STRING;
BEGIN
     BinkFidoAdres:=Word2HexString (Net)+Word2HexString (Node);
END;


{--------------------------------------------------------------------------}
{ GetBinkOutboundDir                                                       }
{                                                                          }
{ This routine returns the correct outbound path based on the Binkley      }
{ rules:                                                                   }
{                                                                          }
{ - use main outbound for main aka                                         }
{ - use main outbound + extension when domain matches main domain          }
{ - use domain + extension when zone and domain match a system aka         }
{ - use main outbound + extension for all others                           }
{ - the match in the domain is only used when there is a match with a      }
{   system aka                                                             }
{                                                                          }
{ or:                                                                      }
{                                                                          }
{ - If receivers zone = zone 'other' aka then do                           }
{     - If receivers domain name = domain name 'matched zone' aka then     }
{       use outbound dir with domain name and zone in extension            }
{     - (when no match found) use main outbound directory with zone in     }
{       extension                                                          }
{ - (when no zone match found) use main outbound directory with zone in    }
{                                                                          }
FUNCTION GetBinkOutboundDir (Adres : FidoAddrType) : STRING;

VAR Temp : STRING;
    Lp   : 1..MaxAKAs;
    Dir  : DirStr;
    Name : NameStr;
    Ext  : ExtStr;

BEGIN
     Temp:=Config.Outbound_F;
     IF (Temp[Length (Temp)] = '\') THEN
        Delete (Temp,Length (Temp),1);

     { if receivers zone = zone main aka then use main outbound dir }
     IF (Adres.Zone = Config.NodeNrs[1].Zone) THEN
     BEGIN
          { use the default outbound directory if the destination zone }
          { matches the zone for our main aka.                         }
          GetBinkOutboundDir:=Temp;
          Exit;
     END;

     { see if we have a system aka that matches the destination zone }
     { if the domain matches as well, then use the domain dir.       }
     IF (Adres.Domain <> '') THEN
        FOR Lp:=2 TO MaxAKAs DO
            IF (Adres.Zone = Config.NodeNrs[Lp].Zone) AND
               (CaselessMatch (Adres.Domain,Config.NodeNrs[Lp].Domain)) THEN
            BEGIN
                 { use domain name as directory }

                 { nu wordt het minder leuk. Strip de standaard outbound, }
                 { en plaats er een DOMAIN naam voor.                     }
                 Temp:=StripLastDirectory (Temp);

                 { remove dot from domain name, if any }
                 IF (Pos ('.',Adres.Domain) > 0) THEN
                    Adres.Domain:=Copy (Adres.Domain,1,Pos ('.',Adres.Domain)-1);

                 GetBinkOutboundDir:=Temp+Adres.Domain+'.'+Copy (Word2HexString (Adres.Zone),2,3);
                 Exit;
            END;

     { use main outbound + extension }

     { backslash is al fietsen, dus het laatste pad deel wordt opgesplitst }
     { in een Name en Ext. En de Ext gaan we weglaten, want anders krijgen }
     { we BINK.OUT.001 bijvoorbeeld.                                       }
     FSplit (Temp,Dir,Name,Ext);
     GetBinkOutboundDir:=Dir+Name+'.'+Copy (Word2HexString (Adres.Zone),2,3);
END;


{--------------------------------------------------------------------------}
{ BinkleyOutbound                                                          }
{                                                                          }
{ Voor volledige ondersteuning van de binkleyterm 5D adressering is enig   }
{ puzzel werk nodig. Geef een adres, en deze routine geeft de directory,   }
{ afgeleid uit de standaard outbound, waar de files moeten komen.          }
{                                                                          }
{ RWI 951105: De terug gegeven outbound directory wordt nu op existentie   }
{             gecontroleerd en eventueel aangemaakt.                       }
{                                                                          }
FUNCTION BinkleyOutbound (Adres : FidoAddrType) : STRING;

VAR Directory : STRING;
    FindDir   : SearchRec;
    IORes     : BYTE;
    UserRecNr : UserBaseRecordNrType;
    UserRec   : UserBaseRecord;

BEGIN
     Directory:='';

     UserRecNr := GetUserBaseRecordNrByAddress (Adres.Zone, Adres.Net, Adres.Node, Adres.Point);
     IF (UserRecNr <> NILRecordNr) THEN
     BEGIN
          ReadUserBaseRecord (UserRecNr, UserRec);
          IF (UserRec.NodeOutDir <> '') THEN
               Directory := UserRec.NodeOutDir;
     END;

     IF (Directory = '') THEN BEGIN
        { zorg voor een geldige domain naam }
        {CheckDomain (Adres);}
   
        Directory:=GetBinkOutboundDir (Adres);
   
        { kijk of deze directory bestaat en maak em anders aan }
        IORes:=CreatePath (Directory);
        IF (IORes <> 0) THEN
            LogDiskIOError (IORes,'Cannot create binkley outbound directory '+Directory);
   
        { voeg een verwijzing naar de point directory }
        { toe, ala 02000011.PNT                       }
   
        IF (Adres.Point > 0) THEN
        BEGIN
             Directory:=Directory+'\'+BinkFidoAdres (Adres.Net,Adres.Node)+'.PNT';
   
             IORes:=CreatePath (Directory);
             IF (IORes <> 0) THEN
                LogDiskIOError (IORes,'Cannot create binkley outbound directory '+Directory);
        END;

        Directory := Directory + '\';
     END;

   BinkleyOutbound := Directory;
END;


{--------------------------------------------------------------------------}
{ Bink_AddToOutFile                                                        }
{                                                                          }
{ Deze routine voegt een regel toe aan de binkley outbound flow. Als zo'n  }
{ regel nog niet bestaat tenminste.                                        }
{                                                                          }
PROCEDURE Bink_AddToOutFile (Filename,Line : STRING);

VAR OutFile : TEXT;
    IORes   : BYTE;
    Regel   : STRING;

BEGIN
     Assign (OutFile,Filename);
     {$I-} Reset (OutFile); {$I+} IORes:=IOResult;
     IF (IORes = 0) THEN
     BEGIN
          {$IFDEF LogFileIO}PostOpenT (OutFile);{$ENDIF}

          WHILE (NOT Eof (OutFile)) DO
          BEGIN
               ReadLn (OutFile,Regel);
               IF (Regel = Line) THEN
               BEGIN
                    { bestaat al }
                    {$IFDEF LogFileIO}PreCloseT (OutFile);{$ENDIF}
                    Close (OutFile);
                    Exit;
               END;
          END;

          {$IFDEF LogFileIO}PreCloseT (OutFile);{$ENDIF}
          Close (OutFile);

          {$I-} Append (OutFile); {$I+} IORes:=IOResult;
          IF (IORes <> 0) THEN
          BEGIN
               LogDiskIOError (IORes,'Cannot append to '+Filename);
               Exit;
          END;

          {$IFDEF LogFileIO}PostOpenT (OutFile);{$ENDIF}
     END ELSE
     BEGIN
          { probeer de file aan te maken }
          {$I-} ReWrite (OutFile); {$I+} IORes:=IOResult;
          IF (IORes <> 0) THEN
          BEGIN
               LogDiskIOError (IORes,'Cannot create '+Filename);
               Exit;
          END;

          {$IFDEF LogFileIO}PostOpenT (OutFile);{$ENDIF}
     END;

     { toevoegen }
     WriteLn (OutFile,Line);

     {$IFDEF LogFileIO}PreCloseT (OutFile);{$ENDIF}
     Close (OutFile);

     IF Config.LogDebug THEN
     BEGIN
          LogMessage (liTrivial,'Added "'+Line+'"');
          LogExtraMessage ('to '+Filename);
     END;
END;


{--------------------------------------------------------------------------}
{ BinkCreateOUTfile                                                        }
{                                                                          }
{ Overgenomen uit de FidoPack routine, aangezien dit nogal wat ruimte      }
{ bespaarde. De routine creert een *.OUT bestandje.                        }
{                                                                          }
{ Toevoegen van KillType  , # = Kill after send                            }
{                          '' = <noppes> Afblijven na verzending           }
{ voor tims:                                                               }
{                          # = Truncate to zero bytes after sending        }
{                          ^ = Kill after sending                          }
{                                                                          }
{ Zie voor meer types de Binkleyterm / TIMS documentatie...                }
{                                                                          }
FUNCTION BinkCreateOutFile (KillType : STRING; Directory,FileName : STRING;
                            Address : FidoAddrType; SendFormat : SendType) : BOOLEAN;

VAR IORes     : INTEGER;
    InputLine,
    OutLine,
    OutName   : STRING;
   {OutFile   : TEXT;}

BEGIN
     BinkCreateOutFile:=FALSE;

     IF (Address.Point = 0) THEN
        OutName:=Word2HexString (Address.Net)+
                 Word2HexString (Address.Node)+'.'+SendName[SendFormat]
     ELSE
         OutName:=Long2HexString (Address.Point)+'.'+SendName[SendFormat];

     { Maak de lijn die naar de *.OUT file geschreven moet worden. }
     IF (KillType <> '') THEN
        OutLine:=UpCaseString (KillType+Directory+Filename)
     ELSE
         OutLine:=UpCaseString (Filename);      { geen directory? }

     { RWI 960323: nu in een generieke procedure... }
     Bink_AddToOutFile (Directory+OutName,OutLine);

     BinkCreateOUTfile:=TRUE;

     (*
     { Probeer het bestand te openen, als het nog niet }
     { bestaat, vang de error af en creer het.         }
     Assign (OutFile,Directory+OutName);
     {$I-} Reset (OutFile); {$I+} IORes:=IOResult;
     IF (IORes = 0) THEN
     BEGIN
          { outfile bestaat al. Kijk of onze regel er in voorkomt }
          WHILE (NOT Eof (OutFile)) DO
          BEGIN
               ReadLn (OutFile,InputLine);
               IF (UpCaseString (InputLine) = OutLine) THEN
               BEGIN
                    {$IFDEF LogFileIO}PreCloseT (OutFile);{$ENDIF}
                    Close (OutFile);
                    BinkCreateOutFile:=TRUE; { success }
                    Exit; { bestaat al }
               END;
          END;

          { einde van de file. Ga over in toevoeg mode }
          {$IFDEF LogFileIO}PreCloseT (OutFile);{$ENDIF}
          Close (OutFile);

          {$I-} Append (OutFile); {$I+} IORes:=IOResult;
          IF (IORes <> 0) THEN
          BEGIN
               LogDiskIOError (IORes,'Cannot append to '+Directory+OutName);
               Exit;
          END;

     END ELSE
     BEGIN
          {$I-} ReWrite (OutFile); {$I+} IORes:=IOResult;
          IF (IORes <> 0) THEN
          BEGIN
               LogDiskIOError (IORes,'Unable to create '+Directory+OutName);
               Exit;
          END;

          LogMessage ('Created '+Directory+OutName+' for '+Fido2Str (Address));
     END;

     WriteLn (OutFile,OutLine);

     {$IFDEF LogFileIO}PreCloseT (OutFile);{$ENDIF}
     Close (OutFile);
     *)
END;


{--------------------------------------------------------------------------}
{ BinkOUTfile_AddAttaches                                                  }
{                                                                          }
{ Deze routine voegt attached files toe aan de binkley .OUT file.          }
{ Alle apart genoemde files in de Subject regel worden bekeken en met een  }
{ volledige pad opgenomen. Geen KillType, dus de file is veilig.           }
{                                                                          }
PROCEDURE BinkOUTFile_AddAttaches (DoKFS: Boolean; Subject : STRING; Address : FidoAddrType; SendFormat : SendType);

VAR Outname   : STRING;
    Directory : STRING;
    Filename  : STRING;
    Dir       : DirStr;
    Name      : NameStr;
    Ext       : ExtStr;
    Search    : SearchRec;
    DosErr    : INTEGER;
    AttachFlags: String [2];

    FUNCTION TryHere (D : STRING) : BOOLEAN;

    VAR Search : SearchRec;

    BEGIN
         IF (D = '') THEN
         BEGIN
              TryHere:=FALSE;
              Exit;
         END;

         FindFirst (D+Filename,saJustFiles,Search);
         DosErr:=DosError;
         FindClose (Search);

         TryHere:=(DosErr = 0);

         IF (DosErr = 0) THEN
            Bink_AddToOutFile (Directory+Outname,AttachFlags+D+Filename);
    END;

BEGIN
     Directory:=BinkleyOutbound (Address);

     IF (Address.Point = 0) THEN
        Outname:=Word2HexString (Address.Net)+
                 Word2HexString (Address.Node)+'.'+SendName[SendFormat]
     ELSE
         Outname:=Long2HexString (Address.Point)+'.'+SendName[SendFormat];

     { f/a vlag was gezet op dit bericht, dus de filenames moeten }
     { legaal zijn. Zoek in ieder geval naar de files voordat we  }
     { ze toevoegen aan de .FLO file.                             }
     { we zoeken in de inbounds, outbound en point outbound.      }

     Subject:=DeleteFrontAndBackSpaces (Subject);

     WHILE (Subject <> '') DO
     BEGIN
          IF (Pos (' ',Subject) > 0) THEN
          BEGIN
               Filename:=Copy (Subject,1,Pos (' ',Subject)-1);
               Delete (Subject,1,Pos (' ',Subject));
               Subject:=DeleteFrontSpaces (Subject);
          END ELSE
          BEGIN
               Filename:=Subject;
               Subject:='';
          END;

          { We hebben nu een filename. Als ie zo niet te vinden is en }
          { er is geen directory, probeer dan de inbounds, outbound   }
          { en point outbound.                                        }

          { Some programs (BRE) put the #/^ flags in netmail messages }
          { themself.  We have to strip that out (but remember it) for}
          { the FileFind functions to succeed.                        }
          AttachFlags := Copy (Filename, 1, 1);
          IF (AttachFlags = '#') OR (AttachFlags = '^') THEN
             Delete (Filename, 1, 1)
          ELSE
             AttachFlags := '';

          { Others use the FLAGS kludge and put KFS on it. }
          IF (DoKFS) THEN
             AttachFlags := '^';

          FSplit (Filename,Dir,Name,Ext);
          
          IF (Dir <> '') THEN
          BEGIN
               FindFirst (Filename,saJustFiles,Search);
               DosErr:=DosError;
               FindClose (Search);

               IF (DosErr = 0) THEN
               BEGIN
                    Bink_AddToOutFile (Directory+Outname,AttachFlags+Filename);
                    Continue;
               END;

               LogMessage (liGeneral,'[BinkOut] Skipping missing attached file: '+Filename);
               Continue;
          END;

          { probeer eens met beide inbounds }
          IF TryHere (Config.Inbound_F[1]) THEN
             Continue;

          IF TryHere (Config.Inbound_F[2]) THEN
             Continue;

          { probeer eens met de outbound }
          IF TryHere (Config.Outbound_F) THEN
             Continue;

          { probeer eens met de point outbound }
          IF TryHere (Directory) THEN
             Continue;

          LogMessage (liGeneral,'[BinkOut] Skipping missing attached file: '+Filename);
     END; { while }
END;


{--------------------------------------------------------------------------}
{ BinkCreateREQFile                                                        }
{                                                                          }
{ Creert een binkley stijl request file.                                   }
{                                                                          }
PROCEDURE BinkCreateREQFile (Address : FidoAddrType; FileName : STRING);

VAR IORes     : INTEGER;
    InputLine,
    Outline,
    Directory,
    Outname   : STRING;
    OUTFile   : TEXT;
    Done      : BOOLEAN;

BEGIN
     Directory:=BinkleyOutbound (Address);

     { je kunt niet van een point freqqen, dus als het pointnummer >0 exit }
     IF (Address.Point = 0) THEN
        OutName:=Word2HexString (Address.Net)+
                 Word2HexString (Address.Node)+'.REQ'
     ELSE
         Exit;

     { Probeer het bestand te openen, als het nog niet }
     { bestaat, vang de error af en creer het.         }
     Assign (OutFile,Directory+OutName);
     {$I-} Reset (OUTfile); {$I+} IORes:=IOResult;
     IF (IORes > 0) THEN
        IF (IORes = 2) THEN
        BEGIN
             {$I-}
             ReWrite (OutFile);
             Reset (OutFile);
             {$I+}
             IORes:=IOResult;
             IF (IORes > 0) THEN
             BEGIN
                  LogDiskIoError (IORes,'Unable to create '+Outname);
                  Exit;
             END;
             LogMessage (liTrivial,'Created '+Outname+' for '+Fido2Str (Address));
        END ELSE
        BEGIN
             LogDiskIOError (IORes,'Unable to open '+Outname);
             Exit;
        END;

     {$IFDEF LogFileIO}PostOpenT (OutFile);{$ENDIF}

     { Voeg de regel alleen maar toe als deze nog niet }
     { in de *.REQ file aanwezig is                    }
     Done:=FALSE;
     WHILE (NOT Eof (OUTFile)) DO
     BEGIN
          {$I-} ReadLn (OutFile,InputLine); {$I+}
          IF (InputLine = FileName) THEN
          BEGIN
               { zit al in de file }
               Done:=TRUE;
               Break;
          END;
     END;

     IF (NOT Done) THEN
     BEGIN
          Append (OutFile);
          {$IFDEF LogFileIO}PostOpenT (OutFile);{$ENDIF}

          {$I-} WriteLn (OUTFile,FileName) ; {$I+}
     END;

     {$IFDEF LogFileIO}PreCloseT (OutFile);{$ENDIF}
     Close (Outfile);
END;


{--------------------------------------------------------------------------}
{ BinkleyCheckBusy                                                         }
{                                                                          }
{ Controleert of er voor een bepaalde node op dit moment een BSY vlagfile  }
{ staat. Zoja, vergeet dan dat we dit pakket moeten verwerken en bewaar    }
{ het voor de volgende run.                                                }
{                                                                          }
{ De functie retourneerd TRUE als er Busy flag staat                       }
{                                                                          }
FUNCTION BinkCheckBusy (Directory : STRING; Address : FidoAddrType) : BOOLEAN;

VAR IoRes     : INTEGER;
    InputLine,
    Outline,
    Outname   : STRING;
    OUTFile   : TEXT;
    Done      : BOOLEAN;

BEGIN
     BinkCheckBusy:=FALSE;

     IF (Address.Point = 0) THEN
        OutName:=Word2HexString (Address.Net)+
                 Word2HexString (Address.Node)
     ELSE
         OutName:=Long2HexString (Address.Point);

     OutName:=OutName+'.BSY';

     { Probeer de file in Create/No OverWrite mode aan te maken }
     Assign (OutFile,Directory+OutName);
     {$I-} Reset (OutFile); {$I+} IORes:=IOResult;

     IF (IORes = 2) THEN
     BEGIN
          { Niet gevonden, dus creer een flag file om aan te geven dat }
          { we met deze node bezig zijn !                              }
          {$I-} ReWrite (OutFile); {$I+} IORes:=IOResult;
          {$I-} WriteLn (OutFile,DesktopProgramName); {$I+} IORes:=IOResult;
          IF (IORes = 0) THEN
             Close (OutFile);
     END ELSE
     BEGIN
          { Wel gevonden ! Dat betekent dus dat we NIET naar deze node }
          { mogen schrijven !                                          }
          {$I-} Close (OutFile); {$I+} IORes:=IOResult;
          BinkCheckBusy:=TRUE; { busy }
          LogMessage (liTrivial,'Found '+Directory+OutName);
     END;
END;


{--------------------------------------------------------------------------}
{ BinkClearBusy                                                            }
{                                                                          }
{ Kijkt of er voor een bepaalde node nog een BSY vlag staat, en haalt      }
{ deze weg.                                                                }
{                                                                          }
PROCEDURE BinkClearBusy (Directory : STRING; Address : FidoAddrType);

VAR OutName : STRING;
    OutFile : TEXT;
    IORes   : INTEGER;

BEGIN
     IF (Address.Point = 0) THEN
        OutName:=Word2HexString (Address.Net)+Word2HexString (Address.Node)
     ELSE
         OutName:=Long2HexString (Address.Point);

     OutName:=OutName+'.BSY';

     Assign (OutFile,Directory+OutName);
     {$I-} Erase (OutFile); {$I+} IORes:=IOResult;
END;


{--------------------------------------------------------------------------}
{ MoveFile                                                                 }
{                                                                          }
{ Deze routine verplaatst een bestand van de ene directory naar de andere. }
{                                                                          }
FUNCTION MoveFile (Source,Destination : STRING) : BOOLEAN;

CONST MemBlock  : longint = $FFFF - $8;

VAR SFile,DFile : FILE;
    IORes       : INTEGER;

BEGIN
     MoveFile:=FALSE;

     { Heeft weinig zin als bron en bestemming gelijk zijn }
     IF (Source = Destination) THEN
        Exit;

     { Delete een evenoud bestand, negeer een eventuele foutmelding }
     Assign (DFile,Destination);
     {$I-} Erase (DFile); {$I+} IORes:=IOResult;

     Assign (SFile,Source);
     {$I-} Rename (SFile,Destination); {$I+} IORes:=IOResult;

     IF (IORes = 0) THEN
        MoveFile:=TRUE;
END;


{--------------------------------------------------------------------------}
{ MoveFileWithDirectory                                                    }
{                                                                          }
{ Deze routine verplaatst een bestand van de ene directory naar de andere. }
{                                                                          }
FUNCTION MoveFileWithDirectory (Source,Destination : STRING) : BOOLEAN;

TYPE Memory = ARRAY[0..65000] OF BYTE;

VAR SFile,DFile : FILE;
    IORes       : INTEGER;
    Bytes       : WordLong;
    MemoryP     : ^Memory;
    MemBlock    : WORD;

BEGIN
     { Heeft weinig zin als bron en bestemming gelijk zijn }
     IF (UNC_FExpand (Source) = UNC_FExpand (Destination)) THEN
     BEGIN
          MoveFileWithDirectory:=TRUE;
          Exit;
     END;

     MoveFileWithDirectory:=FALSE; { assume error }

     IF (_MaxAvail < 65000) THEN
        MemBlock:=_MaxAvail
     ELSE
         MemBlock:=65000;

     GetMem (MemoryP,MemBlock);
     {$IFDEF LogGetMem} LogGetMem (MemoryP,SizeOf (MemBlock),'GetMem Bink.MoveFileWithDirectory'); {$ENDIF}

     { Delete een eventueel oud bestand, negeer een eventuele foutmelding }
     Assign (DFile,Destination);
     Assign (SFile,Source);
     {$I-}
     ReWrite (DFile,1);
     Reset (SFile,1);
     {$I+}

     IORes:=IOResult;
     IF (IORes > 0) THEN
     BEGIN
          LogDiskIOError (IORes,'Unable to open file for move');
          Exit;
     END;

     {$IFDEF LogFileIO}PostOpenF (SFile);{$ENDIF}
     {$IFDEF LogFileIO}PostOpenF (DFile);{$ENDIF}

     REPEAT
           {$I-}
           BlockRead (SFile,MemoryP^,MemBlock,Bytes);
           BlockWrite (DFile,MemoryP^,Bytes);
           {$I+}

           IORes:=IOResult;
           IF (IOResult > 0) THEN
           BEGIN
                LogDiskIOError (IORes,'Unable to complete move of file');
                Exit;
           END;

     UNTIL (Bytes = 0);

     {$I-}
     {$IFDEF LogFileIO}PreCloseF (SFile);{$ENDIF}
     Close (SFile);

     {$IFDEF LogFileIO}PreCloseF (DFile);{$ENDIF}
     Close (DFile);

     Erase (SFile);
     {$I+}
     IORes:=IOResult;       { Strip de error code }

     FreeMem (MemoryP,MemBlock);

     IF (IOResult = 0) THEN
        MoveFileWithDirectory:=TRUE;
END;


END.

