rSyntax10.Scn.FntSyntax10b.Scn.FntSyntax10i.Scn.Fnt?p_VersionElemsAllocBeg#Syntax10.Scn.FntPowerMac Windows Windows31WindowsPowerMac$Syntax14b.Scn.FntPowerMacWindows Windows31$Syntax14b.Scn.Fnt Windows 3.1Syntax14b.Scn.Fnt p_VersionElemsAllocEnd ]ParcElemsAlloc8FoldElemsNewSyntax10.Scn.FntSyntax10i.Scn.Fnt\ParcElemsAlloc#9 'p (************************************************************************ Revision History: 951118 GO all first release 951220 GO FTP moved a lot of logic to FTPSession. FTPDevObj added rudimentary support for VMS hosts; still very messy. 960114 GO FTPSession added GetFile & PutFile FTPDevObj support for NLST cmd, new Icons for LinkElems, improved link handling, renaming, dir caching, cleaned up code 960116 GO FTPDevObj added Append method with special treatment for VMS path specs. FTP added more commands 960126 GO FTPDevObj added full VMS directory list parsing 950301 GO FTP, FTPDevObj added TextFrames.Mark calls all incorporated changes suggested by CS 960307 GO all code cleanup all added autoType FTP fixed WriteHostAddr (Windows) 960509 GO FTPSession added ToggleLog, fixed a bug in AdjustType now it's possible to rename copied files FTP added CopyTo and ToggleLog commands 960512 GO FTPDevObj MM clicking on a selected item now works for directories, too (a text viewer showing the contents of the directory is opened). 960516 GO FTP, FTPSession fixed a bug in computing the bps rate 960520 GO all FTPB replaces FTPControl & FTPData 960521 GO FTPSession extension mapping now works better (patterns without an asterisk as first char didn't work) and is no longer case sensitive. should now work with the NetPresenz server on the Macintosh FTP merged FTPSession & FTPDevObj 960604 GO FTP fixed bug in InitiateTransfer. Some errors where not reported to the caller. GetFile and PutFile now reset the transfer queue if they encounter an error. ReadPasswords now prints an asterisk for each entered char. 960904 CS FTP New version Windows31 in VersionElem where "&" is prepended to local file name. Under Win95 and WinNT this is no longer necessary. Strings.Append(Directories.delimiter), and "*" after GetProfStr("User", "DownloadsFolder"... 961219 GO FTP Added check for 500 reply when a data transfer is completed. The downloads folder is created on startup is it does not exist. ************************************************************************) 838#Syntax10.Scn.Fnt TCP, FTPB, T := Texts, Directories, Display, Viewers, MenuViewers, TextFrames, FMFrames, FMDevObj, FMSysDevObj, FMElems, O := Oberon, Strings, Input, Kernel, SYSTEM; 828Syntax10.Scn.FntSyntax10i.Scn.Fnt0Syntax10b.Scn.Fnte4^< H,Y (* FTPSession consts *) profile = "FTP.Profile"; typeUNIX = "UNIX"; (* remote system types *) typeVMS = "VMS"; typeWinNT = "Windows_NT"; typeMacOS = "MACOS"; typeOther = ""; asciiType = 0; (* transfer modes *) binaryType = 1; autoType = 2; cntlOpenErr = 1; (* error codes *) dataOpenErr = 2; dataListenErr = 3; replyTimeOutErr = 4; notAvailErr = 5; tempNotAvailErr = 6; loginErr = 7; cwdErr = 8; resolveErr = 9; dataConnLostErr = 10; cntlConnLostErr = 11; dataTransferFailedErr = 15; wrongVwrErr = 30; transmInProgErr = 31; noConnectionErr = 32; fileNotFoundErr = 40; fileCreationErr = 41; unexpectedErr = 99; minTab = 4*TextFrames.mm; maxTabs = TextFrames.MaxTabs; (* FTPDevObj consts *) showPrivs = "privs"; showOwner = "owner"; showLinks = "links"; tab = 09X; cacheSize = 8; (* # of cached directories *) lightgray = 12; middlegray = 13; darkgray = 14; black = 15; (* icon colors *) arrow = -1; (* for TextFrames.Mark *) position = 1; dirMenu = "System.Close System.Copy System.Grow "; (* menu for directory viewer *) (* FTP consts *) menu = "^FTP.Menu.Text"; selectCmd = 0; (* for ExecuteCmd *) sortCmd = 1; switchAttributesCmd = 2; viewCmd = 3; refreshCmd = 4; setDirCmd = 5; 88Syntax10.Scn.FntSyntax10i.Scn.Fnt@/`-ASyntax10b.Scn.Fnt*:"(&=#:  @ A " " ! !8  9%  @ 2&%Q (* FTPSession types *) TransferQueue = POINTER TO TransferQueueDesc; TransferQueueDesc = RECORD rw: FTPB.ReaderWriter; localDev: FMDevObj.Device; (* for opening the file *) localParent-: FMElems.FolderElem; localFile-: FMElems.Elem; (* must be equal to remoteFile, except name *) remoteDev: FMDevObj.Device; remoteParent-: FMElems.FolderElem; remoteFile-: FMElems.Elem; (* must be equal to localFile, except name *) open-: BOOLEAN; (* when receiving a file: open it after transfer has completed *) next: TransferQueue END; FTPTransmission* = POINTER TO FTPTransmissionDesc; FTPSession = POINTER TO FTPSessionDesc; FTPSessionDesc = RECORD hostAddr-: TCP.IpAdr; uid, pwd, acct: ARRAY 32 OF CHAR; (* needed for re-opening the connection *) logEnable-: BOOLEAN; remoteType-: ARRAY 16 OF CHAR; (* remote system type *) autoType-: BOOLEAN; (* set file type automatically *) fileType-: INTEGER; (* file type: asciiType or binaryType *) useNLST-: BOOLEAN; (* retireve dir listing using NLST *) cntlConn-: FTPB.FTPCntlConn; curTrans-: FTPTransmission; (* current transmission, if any *) transferQueue-: TransferQueue; elemHint: FMElems.Elem; (* for GetElemHint *) localName: ARRAY 32 OF CHAR; (* local name for CopyTo *) END; FTPTransmissionDesc* = RECORD(FTPB.FTPTransmissionDesc) fileSize-: LONGINT; itsSession: FTPSession END; Text = POINTER TO TextDesc; TextDesc = RECORD(FMFrames.TextDesc) itsSession-: FTPSession END; Reader* = POINTER TO ReaderDesc; ReaderDesc* = RECORD(FTPB.ReaderDesc) sysReader: FMDevObj.Reader END; Writer* = POINTER TO WriterDesc; WriterDesc* = RECORD(FTPB.WriterDesc) sysWriter: FMDevObj.Writer END; BinaryReader* = POINTER TO BinaryReaderDesc; BinaryReaderDesc* = RECORD(ReaderDesc) END; BinaryWriter* = POINTER TO BinaryWriterDesc; BinaryWriterDesc* = RECORD(WriterDesc) END; AsciiReader* = POINTER TO AsciiReaderDesc; AsciiReaderDesc* = RECORD(ReaderDesc) END; AsciiWriter* = POINTER TO AsciiWriterDesc; AsciiWriterDesc* = RECORD(WriterDesc) END; Task* = POINTER TO TaskDesc; TaskDesc* = RECORD(O.TaskDesc) itsSession: FTPSession END; (* FTPDevObj types *) CacheEntry = RECORD valid: BOOLEAN; timeStamp: LONGINT; path:FMDevObj.Path; pattern: FMElems.Name; list: FMDevObj.List END; Device* = POINTER TO DeviceDesc; DeviceDesc* = RECORD(FMDevObj.DeviceDesc) itsSession: FTPSession; dirCache: POINTER TO ARRAY OF CacheEntry; itsSysDevObj: FMDevObj.Device; downloadsFolder: FMElems.FolderElem END; FileElem* = POINTER TO FileElemDesc; FileElemDesc* = RECORD(FMElems.ElemDesc) privs-: ARRAY 32 OF CHAR; (* access privileges *) owner-: ARRAY 16 OF CHAR; (* owner name *) group-: ARRAY 16 OF CHAR; (* group name *) parent-: FMElems.FolderElem END; FolderElem* = POINTER TO FolderElemDesc; FolderElemDesc* = RECORD(FMElems.FolderElemDesc) path: FMDevObj.Path END; LinkElem* = POINTER TO LinkElemDesc; LinkElemDesc* = RECORD(FolderElemDesc) dest: FMDevObj.Path; (* destination of link *) destIsFile-: BOOLEAN; (* is destination of link a file? *) parent-: FMElems.FolderElem END; (* FTP types *) Profile = RECORD ftp: RECORD type: INTEGER; logging: BOOLEAN; useNLST: BOOLEAN; END; display: RECORD date: BOOLEAN; size: BOOLEAN; privs: BOOLEAN; owner: BOOLEAN; links: BOOLEAN; sort: ARRAY 32 OF CHAR; END; user: RECORD downloadsFolder: FMDevObj.Path; mail: ARRAY 256 OF CHAR; END; END; 8r8JSyntax10b.Scn.FntSyntax10.Scn.Fnt5E linkIcon: FMElems.Icon; linkOpenIcon: FMElems.Icon; w: T.Writer; 8&&z8QSyntax10.Scn.FntSyntax10i.Scn.FntO>6 (* Called between mark and scan phases of the GC. *) (* Closes the control connection (by sending a QUIT *) (* command to the server and then closing the connection). *) (* The reply from the server is ignored. *) (* This finalizer is necessary because *) (* a) we can't intercept a System.Close call, and *) (* b) there may be more than one viewer using *) (* the Session (since viewers can be copied with System.Copy), *) (* so intercepting the System.Close doesn't solve the problem anyway... *) VAR s: FTPSession; BEGIN s := SYSTEM.VAL(FTPSession, obj); IF (s IS FTPSession) & (s.cntlConn # NIL) & s.cntlConn.isOpen THEN s.cntlConn.SendCommand("QUIT"); (* waiting for a reply would possibly take too much time for a Finalizer. *) s.cntlConn.Close(); s.cntlConn := NIL END END Finalizer; 8 \8 Syntax10.Scn.FntSyntax10b.Scn.Fnt8FoldElemsNew#Syntax10.Scn.FntGG BEGIN IF len1 < len2 THEN RETURN len1 END; RETURN len2 END Min; 8Syntax10i.Scn.Fnt5  VAR w: T.Writer; text: Text; copyMsg: T.CopyMsg; widths: ARRAY maxTabs OF LONGINT; nOfTabs: INTEGER; i: INTEGER; PROCEDURE Min(len1, len2: LONGINT): LONGINT; BEGIN (* The following code is taken from FMFrames.Mod *) NEW(text); T.Open(text, ""); text.notify := TextFrames.NotifyDisplay; text.devObj := devObj; TextFrames.defParc.handle(TextFrames.defParc, copyMsg); copyMsg.e(TextFrames.Parc).left := 0; copyMsg.e(TextFrames.Parc).nofTabs := 0; T.OpenWriter(w); T.WriteElem(w, copyMsg.e); T.WriteElem(w, folder); folder.GetAttributeWidths(widths, folder.attributes); nOfTabs := SHORT(Min(folder.attributes.nOfAttributes + 1, maxTabs)); copyMsg.e(TextFrames.Parc).nofTabs := nOfTabs; copyMsg.e(TextFrames.Parc).tab[0] := folder.W + minTab; FOR i := 1 TO nOfTabs - 1 DO copyMsg.e(TextFrames.Parc).tab[i] := copyMsg.e(TextFrames.Parc).tab[i-1] + widths[i-1] + minTab END; T.Append(text, w.buf); FMFrames.SwitchFolder(text, folder); text.itsSession := s; RETURN text END NewText; 8#*8#Syntax10.Scn.Fnt// BEGIN T.WriteString(w, str) END WriteString; 88#Syntax10.Scn.Fnt"" BEGIN T.WriteLn(w) END WriteLn; 85Z8CSyntax10.Scn.FntSyntax10i.Scn.Fnt%>d (* Appends a buffer to Oberon.Log *) BEGIN IF enable THEN T.Append(O.Log, buf) END END LogBuffer; 8:<8CSyntax10.Scn.FntSyntax10i.Scn.Fnt&[ (* Appends a message to Oberon.Log *) BEGIN IF enable THEN WriteString(msg); WriteLn; LogBuffer(w.buf, TRUE) END END LogString; 8$=8CSyntax10.Scn.FntSyntax10i.Scn.Fnt-S (* Appends an error message to Oberon.Log *) BEGIN WriteString("FTP Error: "); CASE errNo OF cntlOpenErr: WriteString("Can't open control connection."); | dataOpenErr: WriteString("Can't open data connection."); | dataListenErr: WriteString("Can't listen on data connection."); | replyTimeOutErr: WriteString("Can't get reply from server (time out or connection lost)."); | notAvailErr: WriteString("Service is not available."); | tempNotAvailErr: WriteString("Service is not available now. Try again later."); | loginErr: WriteString("Login incorrect."); | cwdErr: WriteString("Can't change working directory."); | resolveErr: WriteString("Can't resolve host address."); | dataConnLostErr: WriteString("Lost data connection. File transfer aborted."); | cntlConnLostErr: WriteString("Lost control connection."); | dataTransferFailedErr: WriteString("Data transfer failed."); | unexpectedErr: WriteString("Unexpected reply code."); | wrongVwrErr: WriteString("This is not a FTP Viewer."); | transmInProgErr: WriteString("Can't do that while a file transmission is in progress."); | noConnectionErr: WriteString("The connection to the server has been closed."); | fileNotFoundErr: WriteString("File not found."); | fileCreationErr: WriteString("Can't create file."); ELSE WriteString("unknown error code: "); T.WriteInt(w, errNo, 0) END ; WriteLn; LogBuffer(w.buf, TRUE) END LogError; 8K8CSyntax10.Scn.FntSyntax10i.Scn.Fnt' (* Prompts for the user to enter a password. *) (* Doesn't echo input to screen, but draws an asterisk for each entered char. *) VAR i: INTEGER; ch: CHAR; BEGIN WriteString(prompt); LogBuffer(w.buf, TRUE); i := 0; Input.Read(ch); WHILE (ch # 0DX) & (i < LEN(passwd)) DO WriteString("*"); LogBuffer(w.buf, TRUE); passwd[i] := ch; INC(i); Input.Read(ch); END; passwd[i] := 0X; LogString("", TRUE); END ReadPassword; 83v8#Syntax10.Scn.Fnthh VAR ch: CHAR; BEGIN LogString(prompt, TRUE); Input.Read(ch); RETURN (CAP(ch) = 'Y'); END Confirm; 8g8_Syntax10.Scn.FntSyntax10i.Scn.Fnt# (* Searches the specified attribute in the profile and returns a scanner for the profile *) (* text if the search was successfull. The value of the attribute can be obtained by *) (* calling Texts.Scan(s). *) VAR profText: T.Text; found: BOOLEAN; BEGIN NEW(profText); T.Open(profText, profile); T.OpenScanner(s, profText, 0); found := FALSE; success := FALSE; REPEAT (* Search section *) REPEAT T.Scan(s) UNTIL s.eot OR (s.class = T.Char) & (s.c = '['); IF ~s.eot THEN T.Scan(s); found := (s.class = T.Name) & (s.s = section); IF found THEN (* Search attribute *) REPEAT T.Scan(s) UNTIL s.eot OR (s.class = T.Name) & (s.s = attr); IF ~s.eot THEN T.Scan(s); success := (s.class = T.Char) & (s.c = '='); END; END; END; UNTIL s.eot OR found END FindProfile; 84V8QSyntax10.Scn.FntSyntax10i.Scn.Fnt!wZ VAR success: BOOLEAN; s: T.Scanner; BEGIN Strings.Cap(name); FindProfile(profile, "Type", "ASCII", success, s); IF success THEN T.Scan(s); WHILE s.class = T.String DO Strings.Cap(s.s); (* actually a little bit dirty *) IF Strings.Match(name, s.s) THEN RETURN asciiType END; T.Scan(s) END END; RETURN binaryType END MapSuffix; 8O8mSyntax10.Scn.FntSyntax10i.Scn.FntJJ (* Copies the last line of a reply into a string. *) (* In a multi-line reply, the last line usually contains the important information. *) (* The decimal reply-code (first for chars of every line) is not copied to the string. *) (* MUST ALWAYS BE CALLED BEFORE LogBuffer! *) VAR b: T.Buffer; t: T.Text; r: T.Reader; ch: CHAR; i: INTEGER; BEGIN (* Copy the buffer, create a new text with it, and copy it to a string. *) NEW(b); T.OpenBuf(b); T.Copy(replyText.buf, b); NEW(t); t.notify := TextFrames.NotifyDisplay; T.Open(t, ""); T.Append(t, b); T.OpenReader(r, t, 0); T.Read(r, ch); WHILE ~r.eot DO i := 0; T.Read(r, ch); T.Read(r, ch); T.Read(r, ch); (* skip reply code *) IF ~r.eot THEN T.Read(r, ch); WHILE ~r.eot & (ch # 0DX) DO IF i < LEN(replyString) - 1 THEN replyString[i] := ch; INC(i) END; T.Read(r, ch) END; replyString[i] := 0X; END; IF ~r.eot THEN T.Read(r, ch) END; (* first char of next line *) END END ReplyToString; 8$G8CSyntax10.Scn.FntSyntax10i.Scn.Fnt~w (* Returns the current session. The session is determined using the viewer *) (* from which the command has been issued. *) VAR v: Viewers.Viewer; f: Display.Frame; t: T.Text; s: FTPSession; BEGIN s := NIL; IF O.Par.frame = O.Par.vwr.dsc THEN v := O.Par.vwr ELSE v := O.MarkedViewer() END; WITH v: MenuViewers.Viewer DO f := v.dsc.next; WITH f: TextFrames.Frame DO t := f.text; WITH t: Text DO s := t.itsSession; ELSE END ELSE END ELSE END; IF s = NIL THEN LogError(wrongVwrErr); RETURN NIL END; IF s.cntlConn = NIL THEN LogError(noConnectionErr); RETURN NIL END; RETURN s END GetSession; 8/8CSyntax10.Scn.FntSyntax10i.Scn.Fnt8 (* Returns the current session's frame. The session is determined using the viewer *) (* from which the command has been issued. *) VAR v: Viewers.Viewer; f: Display.Frame; BEGIN IF O.Par.frame = O.Par.vwr.dsc THEN v := O.Par.vwr ELSE v := O.MarkedViewer() END; WITH v: MenuViewers.Viewer DO f := v.dsc.next; WITH f: TextFrames.Frame DO RETURN f; ELSE END ELSE END; LogError(wrongVwrErr); RETURN NIL END GetSessionFrame; 8/8CSyntax10.Scn.FntSyntax10i.Scn.Fnt& (* Returns the frame which contains the current mouse coordinates. *) (* This is needed in FTPDevObj to determine the textframe to be marked. *) VAR v: Viewers.Viewer; f: Display.Frame; k: SET; x, y: INTEGER; BEGIN Input.Mouse(k, x, y); v := Viewers.This(x, y); WITH v: MenuViewers.Viewer DO f := v.dsc.next; WITH f: TextFrames.Frame DO RETURN f; ELSE RETURN NIL; END ELSE RETURN NIL; END END GetFrameByMouse; 8-8#Syntax10.Scn.Fnt33 BEGIN s.useNLST := ~s.useNLST END ToggleUseNLST; 8'8#Syntax10.Scn.Fnt33 BEGIN s.logEnable := ~s.logEnable END ToggleLog; 8.j8CSyntax10.Scn.FntSyntax10i.Scn.Fnt&,T (* Checks if the connection is open *) BEGIN RETURN s.cntlConn # NIL END IsOpen; 8ej8#Syntax10.Scn.Fnttt BEGIN ASSERT (s.IsOpen()); LogString(req, s.logEnable); s.cntlConn.Request(req, replyCode, replyText); END Req; 8\8CSyntax10.Scn.FntSyntax10i.Scn.Fnt VAR command: ARRAY 256 OF CHAR; replyCode: INTEGER; replyText: T.Writer; BEGIN COPY(cmd, command); Strings.Append(dir, command); s.Req(command, replyCode, replyText); LogBuffer(replyText.buf, s.logEnable); success := replyCode = 250 END Do; 8Pb8CSyntax10.Scn.FntSyntax10i.Scn.Fnt)1\ (* Sends a CWD command to the server. *) BEGIN s.Do(dir, "CWD ", success) END ChangeDir; 8Pb8CSyntax10.Scn.FntSyntax10i.Scn.Fnt)1\ (* Sends a RMD command to the server. *) BEGIN s.Do(dir, "RMD ", success) END RemoveDir; 8R_8CSyntax10.Scn.FntSyntax10i.Scn.Fnt)4_ (* Sends a CWD command to the server. *) BEGIN s.Do(file, "DELE ", success) END DeleteFile; 8Q|8QSyntax10.Scn.FntSyntax10i.Scn.FntC*54 (* Sends a PWD command to the server and interprets the reply. *) VAR replyCode: INTEGER; replyText: T.Writer; replyStr: ARRAY 256 OF CHAR; i: INTEGER; BEGIN s.Req("PWD", replyCode, replyText); ReplyToString(replyText, replyStr); LogBuffer(replyText.buf, s.logEnable); COPY("/", dir); success := (replyCode = 257); IF success THEN IF replyStr[0] = '"' THEN (* the reply contains a valid path specification *) i := 1; WHILE (replyStr[i] # 0X) & (replyStr[i] # '"') DO dir[i - 1] := replyStr[i]; INC(i) END; dir[i - 1] := 0X END END END GetDir; 8M8CSyntax10.Scn.FntSyntax10i.Scn.Fnt+ (* Sends a TYPE command to the server. *) VAR cmd: ARRAY 8 OF CHAR; replyCode: INTEGER; replyText: T.Writer; BEGIN CASE type OF asciiType: cmd := "TYPE A"; | binaryType: cmd := "TYPE I"; END; s.Req(cmd, replyCode, replyText); LogBuffer(replyText.buf, s.logEnable); success := FTPB.GetReplyCategory(replyCode) = FTPB.positiveCompletion; IF ~success THEN LogError(unexpectedErr) ELSE s.fileType := type END END SendTypeCmd; 8M8CSyntax10.Scn.FntSyntax10i.Scn.Fnt (* Sets the file type. *) BEGIN IF type = autoType THEN s.autoType := TRUE; s.SendTypeCmd(binaryType, success) ELSE s.autoType := FALSE; s.SendTypeCmd(type, success) END END SetFileType; 81u8QSyntax10.Scn.FntSyntax10i.Scn.FntUK&s; (* Sends SITE DIRSTYLE commands to the server until it turns DOS-like output off *) VAR replyCode: INTEGER; replyText: T.Writer; replyStr: ARRAY 256 OF CHAR; siteCmd: ARRAY 32 OF CHAR; BEGIN siteCmd := "SITE DIRSTYLE"; s.Req(siteCmd, replyCode, replyText); ReplyToString(replyText, replyStr); LogBuffer(replyText.buf, s.logEnable); IF replyCode = 200 THEN IF Strings.Pos(" on", replyStr, 0) > 0 THEN (* oops, we turned on MS-DOS format *) s.Req(siteCmd, replyCode, replyText); LogBuffer(replyText.buf, s.logEnable) END END END WinNTSetUNIXFormat; 8C8QSyntax10.Scn.FntSyntax10i.Scn.FntD (* Sends a SYST command to the server and interprets the reply. *) VAR replyCode: INTEGER; replyText: T.Writer; replyStr: ARRAY 256 OF CHAR; i: INTEGER; BEGIN s.Req("SYST", replyCode, replyText); ReplyToString(replyText, replyStr); (* must be before LogBuffer *) LogBuffer(replyText.buf, s.logEnable); IF FTPB.GetReplyCategory(replyCode) = FTPB.positiveCompletion THEN i := 0; WHILE (replyStr[i] # 0X) & (replyStr[i] # ' ') & (i < LEN(type)) DO type[i] := replyStr[i]; INC(i) END ; type[i] := 0X; IF (type # typeUNIX) & (type # typeVMS) & (type # typeWinNT) & (type # typeMacOS) THEN COPY(typeOther, type) END ELSE COPY(typeOther, type) END END GetSystemType; 898_Syntax10.Scn.FntSyntax10i.Scn.FntK Il (* Re-opens the control connection and logs in. *) (* May be called if the connection has been closed by the server (due to a timeout...) *) (* Is also used by Open. *) VAR cmd: ARRAY 256 OF CHAR; replyCode: INTEGER; replyText: T.Writer; BEGIN (* A new control connection *) NEW(s.cntlConn); s.cntlConn.Open(s.hostAddr, success); IF ~success THEN LogError(cntlOpenErr); RETURN END; s.cntlConn.WaitForReply(replyCode, replyText); LogBuffer(replyText.buf, s.logEnable); CASE FTPB.GetReplyCategory(replyCode) OF FTPB.negativeConnection: LogError(replyTimeOutErr); s.cntlConn.Close(); success := FALSE; RETURN; | FTPB.positivePreliminary: LogError(tempNotAvailErr); s.cntlConn.Close(); success := FALSE; RETURN; | FTPB.negativeTransient: LogError(notAvailErr); s.cntlConn.Close(); success := FALSE; RETURN; | FTPB.positiveCompletion: LogBuffer(replyText.buf, ~s.logEnable); ELSE LogError(unexpectedErr); s.cntlConn.Close(); success := FALSE; RETURN END; cmd := "USER "; Strings.Append(s.uid, cmd); LogString(cmd, s.logEnable); s.cntlConn.Request(cmd, replyCode, replyText); LogBuffer(replyText.buf, s.logEnable); IF replyCode = 331 THEN IF s.pwd = "" THEN ReadPassword("Enter Password: ", s.pwd) END; cmd := "PASS "; Strings.Append(s.pwd, cmd); LogString("PASS ...", s.logEnable); s.cntlConn.Request(cmd, replyCode, replyText); LogBuffer(replyText.buf, s.logEnable); END; IF replyCode = 332 THEN IF s.acct = "" THEN ReadPassword("Enter Account: ", s.acct) END; cmd := "ACCT "; Strings.Append(s.acct, cmd); LogString("ACCT ...", s.logEnable); s.cntlConn.Request(cmd, replyCode, replyText); LogBuffer(replyText.buf, s.logEnable); END; CASE FTPB.GetReplyCategory(replyCode) OF FTPB.negativeConnection: LogError(replyTimeOutErr); s.cntlConn.Close(); success := FALSE; RETURN; | FTPB.negativeTransient: LogError(notAvailErr); s.cntlConn.Close(); success := FALSE; RETURN; | FTPB.negativePermanent: LogError(loginErr); s.cntlConn.Close(); success := FALSE; RETURN; | FTPB.positiveCompletion: LogBuffer(replyText.buf, ~s.logEnable); END; (* Get remote system type *) s.GetSystemType(s.remoteType); IF s.remoteType = typeWinNT THEN s.WinNTSetUNIXFormat() END; END ReOpen; 88QSyntax10.Scn.FntSyntax10i.Scn.Fnt:$L (* Open a TCP connection to the FTP server and log in. *) BEGIN (* Register the finalizer proc. *) Kernel.RegisterObject(s, Finalizer); s.hostAddr := hostAddr; COPY(uid, s.uid); COPY(pwd, s.pwd); COPY(acct, s.acct); s.logEnable := logEnable; s.useNLST := useNLST; s.fileType := fileType; s.curTrans := NIL; s.transferQueue := NIL; s.ReOpen(success); IF ~success THEN RETURN END; s.SetFileType(fileType, success) END Open; 8$8CSyntax10.Scn.FntSyntax10i.Scn.Fnt` (* Sends a QUIT command to the server, *) (* waits for the reply and closes the connection.. *) VAR replyCode: INTEGER; replyText: T.Writer; BEGIN s.Req("QUIT", replyCode, replyText); s.cntlConn.Close(); s.cntlConn := NIL; LogString("Connection closed.", TRUE) END Close; 8C[8_Syntax10.Scn.FntSyntax10i.Scn.FntW&G (* Checks if we're still connected to the server. *) (* If not, try to re-connect. *) VAR success: BOOLEAN; ch: CHAR; BEGIN (* Eat up all unread data *) WHILE TCP.Available(s.cntlConn) > 0 DO TCP.Read(s.cntlConn, ch) END ; IF ~TCP.Connected(s.cntlConn) THEN IF reconnect THEN LogError(cntlConnLostErr); LogString("Trying to re-connect.", TRUE); s.ReOpen(success); (* Set file type *) IF s.autoType THEN s.SetFileType(autoType, success) ELSE s.SetFileType(s.fileType, success) END; RETURN success END ; RETURN FALSE ELSE RETURN TRUE END END Connected; 8$'8QSyntax10.Scn.FntSyntax10i.Scn.Fnt**(  (* Sends an ABOR command to the server. *) VAR replyCode: INTEGER; replyText: T.Writer; BEGIN ASSERT (s.IsOpen()); LogString("ABOR", s.logEnable); s.cntlConn.InterruptProcess(); s.cntlConn.Synch(); s.cntlConn.Request("ABOR", replyCode, replyText); LogBuffer(replyText.buf, s.logEnable); IF replyCode = 426 THEN s.cntlConn.WaitForReply(replyCode, replyText); LogBuffer(replyText.buf, s.logEnable) END; IF s.curTrans # NIL THEN IF s.curTrans.itsConnection # NIL THEN s.curTrans.itsConnection.Close() END; O.Remove(s.curTrans); s.curTrans := NIL END; s.transferQueue := NIL; (* also cancel all queued transfers *) END Abort; 8<8#Syntax10.Scn.Fnt__ VAR e: T.Elem; BEGIN e := NIL; elem.Copy(e); s.elemHint := e(FMElems.Elem) END SetElemHint; 888#Syntax10.Scn.Fnt^^ VAR e: FMElems.Elem; BEGIN e := s.elemHint; s.elemHint := NIL; RETURN e; END GetElemHint; 8>8CSyntax10.Scn.FntSyntax10i.Scn.Fnt1 (* Set the name of the local file if it's not the same as remote file's name *) (* This name is used by GetLocalName. Since the FileManager provides no *) (* way for renaming files during copying (that is, passing the name to *) (* the Copy method), we call SetLocalName from FTP.CopyTo to set the *) (* name of the local file and we call GetLocalName from *) (* FTPDevObj.SourceCopy and FTPDevObj.Open to query that name. *) BEGIN COPY(name, s.localName) END SetLocalName; 8b8ySyntax10.Scn.FntSyntax10i.Scn.Fnt$pVersionElemsAllocBeg#Syntax10.Scn.FntPowerMac Windows Windows31WindowsPowerMac#Syntax10.Scn.Fnt^^ IF s.localName = "" THEN COPY(remoteName, localName) ELSE COPY(s.localName, localName) END; Windows Windows31#Syntax10.Scn.Fnt IF s.localName = "" THEN IF remoteName[0] # '&' THEN COPY("&", localName); Strings.Append(remoteName, localName) ELSE COPY(remoteName, localName) END ELSE COPY(s.localName, localName) END; ^pVersionElemsAllocEnd& (* Determines the local name of a remote file. This name is either equal to the remote name, *) (* or the name set with SetLocalName. In the Windows31 implementation, a '&' is prepended to the name *) (* to prevent Oberon from writing its own header to the beginning of the file. *) BEGIN  IF s.localName = "" THEN COPY(remoteName, localName) ELSE COPY(s.localName, localName) END;  s.localName := "" END GetLocalName; 8c#8Syntax10.Scn.FntSyntax10i.Scn.FntpVersionElemsAllocBeg#Syntax10.Scn.FntPowerMac Windows Windows31WindowsPowerMac#Syntax10.Scn.Fnt COPY(localName, remoteName) Windows Windows31#Syntax10.Scn.Fnt IF localName[0] = '&' THEN Strings.Extract(localName, 1, Strings.Length(localName) - 1, remoteName) ELSE COPY(localName, remoteName) END pVersionElemsAllocEnd (* Needed for the Windows31 implementation. LocalName is copied to remoteName. *) (* Windows31: If the first char of localName is a '&', it is removed in remoteName. *) BEGIN  COPY(localName, remoteName)  END GetRemoteName; 88#Syntax10.Scn.FntOO VAR dummy: ARRAY 1 OF CHAR; BEGIN w.sysWriter.PutBytes(dummy, 0) END Close; 8 .8#Syntax10.Scn.Fnt99 BEGIN r.sysReader.GetBytes(buffer, len); END GetBytes; 8 .8#Syntax10.Scn.Fnt99 BEGIN w.sysWriter.PutBytes(buffer, len); END PutBytes; 8 .58dSyntax10.Scn.Fnt2pVersionElemsAllocBeg#Syntax10.Scn.FntPowerMac Windows Windows31WindowsPowerMacCSyntax10.Scn.FntSyntax10i.Scn.FntR len := 0; r.sysReader.GetBytes(cb, l); WHILE l = 1 DO buffer[len] := cb[0]; INC(len); IF cb[0] = 0DX THEN buffer[len] := 0AX; INC(len) END; (* CR -> CRLF *) IF len < LEN(buffer) - 1 THEN r.sysReader.GetBytes(cb, l) ELSE l := 0 END END Windows Windows31#Syntax10.Scn.Fnt%% r.sysReader.GetBytes(buffer, len); %pVersionElemsAllocEndh VAR cb: ARRAY 1 OF CHAR; l: INTEGER; BEGIN  r.sysReader.GetBytes(buffer, len);  END GetBytes; 8 .8Syntax10.Scn.Fnt.pVersionElemsAllocBeg#Syntax10.Scn.FntPowerMac Windows Windows31WindowsPowerMac#Syntax10.Scn.Fntll FOR i := 0 TO len - 1 DO cb[0] := buffer[i]; IF cb[0] # 0AX THEN w.sysWriter.PutBytes(cb, 1) END END Windows Windows31#Syntax10.Scn.Fnt%% w.sysWriter.PutBytes(buffer, len); %pVersionElemsAllocEndd VAR i: LONGINT; cb: ARRAY 1 OF CHAR; BEGIN  w.sysWriter.PutBytes(buffer, len);  END PutBytes; 8F8#Syntax10.Scn.Fnt^^ VAR r: BinaryReader; BEGIN NEW(r); r.sysReader := sysReader; RETURN r END NewBinaryReader; 8E8#Syntax10.Scn.Fnt^^ VAR w: BinaryWriter; BEGIN NEW(w); w.sysWriter := sysWriter; RETURN w END NewBinaryWriter; 8C8#Syntax10.Scn.Fnt\\ VAR r: AsciiReader; BEGIN NEW(r); r.sysReader := sysReader; RETURN r END NewAsciiReader; 8C8#Syntax10.Scn.Fnt\\ VAR w: AsciiWriter; BEGIN NEW(w); w.sysWriter := sysWriter; RETURN w END NewAsciiWriter; 8*C}8{Syntax10.Scn.FntSyntax10i.Scn.FntRz(*HP  (* Open a data connection, send a PORT command and cmd, accept the connection *) VAR portCmd: ARRAY 256 OF CHAR; replyCode: INTEGER; replyText: T.Writer; BEGIN NEW(d); d.Listen(s.cntlConn, success); (* listen on the data connection port *) IF success THEN (* Send a PORT command to the server *) d.GetPortCmd(portCmd); LogString(portCmd, s.logEnable); s.cntlConn.Request(portCmd, replyCode, replyText); LogBuffer(replyText.buf, s.logEnable); IF replyCode # 200 THEN LogBuffer(replyText.buf, ~s.logEnable); d.Close(); success := FALSE; RETURN END; (* Send the command *) LogString(cmd, s.logEnable); s.cntlConn.Request(cmd, replyCode, replyText); LogBuffer(replyText.buf, s.logEnable); IF FTPB.GetReplyCategory(replyCode) # FTPB.positivePreliminary THEN LogBuffer(replyText.buf, ~s.logEnable); d.Close(); success := FALSE; RETURN END; (* Accept the connection request from the server and read the data *) d.Accept(success); ELSE LogError(dataListenErr) END END InitiateTransfer; 8P08#Syntax10.Scn.Fnt VAR type: INTEGER; BEGIN success := TRUE; IF s.autoType THEN type := MapSuffix(path); IF type # s.fileType THEN s.SendTypeCmd(type, success) END END END AdjustType; 8F_8QSyntax10.Scn.FntSyntax10i.Scn.FntA(Q (* Initiates a file transfer for the first file in the queue *) VAR cmdStr: ARRAY 256 OF CHAR; d: FTPB.FTPDataConn; success: BOOLEAN; path: FMDevObj.Path; BEGIN ASSERT (s.curTrans = NIL); IF ~s.Connected(TRUE) THEN RETURN END; q.remoteDev.GetPath(q.remoteParent, path); q.remoteDev.Append(path, q.remoteFile.name); cmdStr := "RETR "; Strings.Append(path, cmdStr); s.AdjustType(q.remoteFile.name, success); IF success THEN s.InitiateTransfer(d, cmdStr, success) END; IF success THEN NEW(s.curTrans); s.curTrans.fileSize := q.remoteFile.size; s.curTrans.itsSession := s; d.ReceiveFile(s.curTrans, writer); T.WriteString(w, "Retrieving file: "); T.WriteString(w, path); T.WriteLn(w); T.Append(O.Log, w.buf) ELSE LogError(dataOpenErr); s.transferQueue := NIL (* also cancel all queued transfers *) END; END GetFile; 8F>8QSyntax10.Scn.FntSyntax10i.Scn.FntA(r (* Initiates a file transfer for the first file in the queue *) VAR cmdStr: ARRAY 256 OF CHAR; portCmd: ARRAY 256 OF CHAR; d: FTPB.FTPDataConn; success: BOOLEAN; path: FMDevObj.Path; BEGIN ASSERT (s.curTrans = NIL); IF ~s.Connected(TRUE) THEN RETURN END; q.remoteDev.GetPath(q.remoteParent, path); q.remoteDev.Append(path, q.remoteFile.name); cmdStr := "STOR "; Strings.Append(path, cmdStr); s.AdjustType(path, success); IF success THEN s.InitiateTransfer(d, cmdStr, success) END; IF success THEN s.transferQueue := q; NEW(s.curTrans); s.curTrans.fileSize := q.remoteFile.size; s.curTrans.itsSession := s; d.SendFile(s.curTrans, reader); T.WriteString(w, "Sending file: "); T.WriteString(w, path); T.WriteLn(w); T.Append(O.Log, w.buf) ELSE LogError(dataOpenErr); s.transferQueue := NIL (* also cancel all queued transfers *) END END PutFile; 8+8#Syntax10.Scn.Fnt VAR rw: FTPB.ReaderWriter; BEGIN ASSERT (s.curTrans = NIL); IF s.transferQueue # NIL THEN rw := s.transferQueue.rw; IF rw IS Writer THEN s.GetFile(s.transferQueue, rw(Writer)) ELSE s.PutFile(s.transferQueue, rw(Reader)) END; END END StartTransfers; 8$i8#Syntax10.Scn.Fntuu VAR t: Task; BEGIN t := O.CurTask(Task); O.Remove(t); t.itsSession.StartTransfers(); END StartTransfersHandler; 8A|8CSyntax10.Scn.FntSyntax10i.Scn.Fnt^B (* Adds a new file transfer to the file transfer queue. *) (* If the queue is empty, the file transfer is started immediately. *) (* If rw is a Reader, then the file is put on the server; otherwise it's fetched from it. *) VAR q, new: TransferQueue; t: Task; BEGIN ASSERT (s.curTrans = NIL); NEW(new); new.rw := rw; new.localDev := localDev; new.localParent := localParent; new.localFile := localFile; new.remoteDev := remoteDev; new.remoteParent := remoteParent; new.remoteFile := remoteFile; new.open := open; new.next := NIL; IF s.transferQueue # NIL THEN q := s.transferQueue; WHILE q.next # NIL DO q := q.next END; q.next := new ELSE s.transferQueue := new; NEW(t); t.handle := StartTransfersHandler; t.safe := FALSE; t.time := 0; t.itsSession := s; O.Install(t) END END EnqueueTransfer; 8  (8Syntax10.Scn.FntSyntax10i.Scn.FntAK,TSyntax10b.Scn.Fnt&K@/) (* CompletionProc for file transfers. Called upon completion of a file transfer. *) (* Displays a message and executes the specified command. *) VAR i, bps: REAL; q: TransferQueue; msg: FMDevObj.NotifyMsg; replyCode: INTEGER; replyText: T.Writer; BEGIN q := t.itsSession.transferQueue; t.itsSession.transferQueue := q.next; t.itsSession.curTrans := NIL; (* Wait for "Transfer Complete" or other message from server *) t.itsSession.cntlConn.WaitForReply(replyCode, replyText); IF FTPB.GetReplyCategory(replyCode) # FTPB.positiveCompletion THEN (* a 500 reply *) LogError(dataTransferFailedErr); LogBuffer(replyText.buf, TRUE); ELSE (* data transfer completed successfully *) LogBuffer(replyText.buf, t.itsSession.logEnable); IF success THEN i := (O.Time() - t.startTime)/Input.TimeUnit; IF i = 0 THEN i := 1 END; T.WriteString(w, "Transfer completed. ("); T.WriteInt(w, t.bytesTransferred, 0); T.WriteString(w, " bytes in "); T.WriteRealFix(w, i, 0, 1); T.WriteString(w, " sec. = "); bps := t.bytesTransferred/i; IF bps < 1024 THEN T.WriteRealFix(w, bps, 0, 1) ELSE T.WriteRealFix(w, bps/1024, 0, 1); T.WriteString(w, "K") END; T.WriteString(w, " bytes/sec.)"); T.WriteLn(w); T.Append(O.Log, w.buf); IF q.rw IS Writer THEN (* open received file if desired *) IF q.open THEN q.localDev.Open(q.localParent, q.localFile) END ELSE (* refresh server dir display - broadcast a notification *) q.remoteDev.GetPath(q.remoteParent, msg.path); COPY(q.remoteFile.name, msg.name); msg.devObj := q.remoteDev; msg.id := FMDevObj.insert; t.itsSession.SetElemHint(q.remoteFile); Viewers.Broadcast(msg) END ELSE LogError(dataConnLostErr) END END; (* Start next transfer *) t.itsSession.StartTransfers(); END Completed; 898#Syntax10.Scn.Fnt VAR clone: FileElem; BEGIN IF de = NIL THEN NEW(clone); de := clone END; e.Copy^(de); de(FileElem).parent := e.parent; COPY(e.privs, de(FileElem).privs); COPY(e.owner, de(FileElem).owner); COPY(e.group, de(FileElem).group); END Copy; 838#Syntax10.Scn.Fnt BEGIN IF name = showPrivs THEN T.Write(w, tab); T.WriteString(w, e.privs) ELSIF name = showOwner THEN T.Write(w, tab); T.WriteString(w, e.owner); T.Write(w, ' '); T.WriteString(w, e.group) ELSE e.WriteAttribute^(w, name) END END WriteAttribute; 868#Syntax10.Scn.Fnt BEGIN IF name = showPrivs THEN width := FMElems.GetNameWidth(e.privs) ELSIF name = showOwner THEN width := FMElems.GetNameWidth(e.owner) + FMElems.GetNameWidth(" ") + FMElems.GetNameWidth(e.group) ELSE e.GetAttributeWidth^(width, name) END END GetAttributeWidth; 8>8#Syntax10.Scn.Fnt BEGIN FMElems.InitElem(e, name, size, date, time); e.parent := parent; COPY(privs, e.privs); COPY(owner, e.owner); COPY(group, e.group) END InitFileElem; 8U8#Syntax10.Scn.Fnt VAR clone: FolderElem; BEGIN IF de = NIL THEN NEW(clone); de := clone END; f.Copy^(de); COPY(f.path, de(FolderElem).path) END Copy; 88#Syntax10.Scn.Fnt(( BEGIN COPY(f.path, path) END GetPath; 8g8#Syntax10.Scn.Fntww BEGIN FMElems.InitFolderElem(f, name, pattern, sortOrder, attributes, open); COPY(path, f.path) END InitFolderElem; 878#Syntax10.Scn.Fnt VAR clone: LinkElem; BEGIN IF de = NIL THEN NEW(clone); de := clone END; l.Copy^(de); de(LinkElem).parent := l.parent; COPY(l.dest, de(LinkElem).dest) END Copy; 8Y8CSyntax10.Scn.FntSyntax10i.Scn.Fnte (* LinkElems need special treatment if their destination is a file. *) (* Since the link's path already contains the name of the file, we *) (* must take the path of the link's parent folder. *) VAR parent: FolderElem; BEGIN IF l.destIsFile THEN parent := l.parent(FolderElem); COPY(parent.path, path) ELSE COPY(l.path, path) END END GetPath; 83O8#Syntax10.Scn.Fnt BEGIN IF (name = showLinks) & (l.dest # "?") THEN T.Write(w, tab); T.WriteString(w, "=> "); T.WriteString(w, l.dest) END END WriteAttribute; 88#Syntax10.Scn.Fnt BEGIN InitFolderElem(l, path, name, pattern, sortOrder, attributes, open); COPY(dest, l.dest); l.destIsFile := FALSE; l.parent := parent; l.icon := linkIcon; l.iconW := 16; l.iconH := 12; l.openIcon := linkOpenIcon; END InitLinkElem; 8k8#Syntax10.Scn.Fnt!! BEGIN d.GetPath(par, path); IF d.itsSession.remoteType = typeVMS THEN path[Strings.Length(path) - 1] := 0X; Strings.Append(".", path); Strings.Append(name, path); Strings.Append(']', path); ELSE Strings.Append(name, path); Strings.Append("/", path) END END CreateDirPath; 8`8#Syntax10.Scn.Fnt VAR i, oldest: INTEGER; oldestTime: LONGINT; BEGIN i := 0; oldest := 0; oldestTime := d.dirCache[0].timeStamp; found := FALSE; WHILE i < cacheSize DO IF d.dirCache[i].valid THEN IF (d.dirCache[i].path = path) & (d.dirCache[i].pattern = pattern) THEN found := TRUE; RETURN i END; IF d.dirCache[i].timeStamp < oldestTime THEN oldest := i; oldestTime := d.dirCache[i].timeStamp END; ELSE oldest := i; oldestTime := 0 END; INC(i) END; IF i = cacheSize THEN RETURN oldest ELSE RETURN i END END FindCacheEntry; 8+8CSyntax10.Scn.FntSyntax10i.Scn.FntQ; (* Invalidates the specified cache entry and the entries of all it's folders *) VAR i: INTEGER; BEGIN FOR i := 0 TO cacheSize - 1 DO IF d.dirCache[i].valid & (Strings.Pos(path, d.dirCache[i].path, 0) = 0) THEN d.dirCache[i].valid := FALSE; d.dirCache[i].list := NIL END END END InvalidateCacheEntry; 8 8#Syntax10.Scn.Fnt-- BEGIN RETURN TRUE END NeedCopyMoveControl; 8/8CSyntax10.Scn.FntSyntax10i.Scn.Fnt0} (* This method handles VMS paths separately. *) BEGIN IF d.itsSession.remoteType = typeVMS THEN Strings.Append(name, path) ELSE d.Append^(path, name) END END Append; 838#Syntax10.Scn.Fnt33 BEGIN RETURN elem.name = name END CheckIdentity; 8 J8.2Syntax10.Scn.Fnt8FoldElemsNew#Syntax10.Scn.Fnt VAR i: INTEGER; BEGIN i := 0; WHILE (pos < dirEntLen) & (i < LEN(str) - 1) & (dirEnt[pos] # ' ') DO str[i] := dirEnt[pos]; INC(i); INC(pos) END; str[i] := 0X; WHILE (pos < dirEntLen) & (dirEnt[pos] # ' ') DO INC(pos) END END ScanString;8g18#Syntax10.Scn.Fnt BEGIN num := 0; WHILE (pos < dirEntLen) & (dirEnt[pos] >= '0') & (dirEnt[pos] <= '9') DO num := num*10 + ORD(dirEnt[pos]) - ORD('0'); INC(pos) END END ScanNumber;8T8#Syntax10.Scn.FntXX BEGIN WHILE (pos < dirEntLen) & (dirEnt[pos] = ' ') DO INC(pos) END END SkipBlanks;8b38CSyntax10.Scn.FntSyntax10i.Scn.Fntt (* Generic dir entries are treated as links since *) (* it can't be determined wheter we have a file or a dir *) VAR link: LinkElem; name, path: FMDevObj.Path; BEGIN NEW(link); COPY(dirEnt, name); d.CreateDirPath(parent, name, path); InitLinkElem(link, parent, path, "?", name, parent.pattern, parent.sortOrder, parent.attributes, FALSE); elem := link END GetGenericDirEntry; 8c8#Syntax10.Scn.Fnt,, VAR i: INTEGER; file: FileElem; folder: FolderElem; size: LONGINT; name, path: FMDevObj.Path; BEGIN COPY(dirEnt, name); i := Strings.Pos(".dir", name, 0); IF i >= 0 THEN (* a directory *) name[i] := 0X; NEW(folder); d.CreateDirPath(parent, name, path); InitFolderElem(folder, path, name, parent.pattern, parent.sortOrder, parent.attributes, FALSE); elem := folder ELSE size := 0; NEW(file); InitFileElem(file, name, parent, size, 0, 0, "n/a", "n/a", "n/a"); elem := file END END GetShortVMSDirEntry; 8_ 8 Syntax10.Scn.Fnt8FoldElemsNewCSyntax10.Scn.FntSyntax10i.Scn.Fnt  VAR monStr: ARRAY 4 OF CHAR; year, mon, day, hh, mm: LONGINT; BEGIN ScanNumber(dirEnt, dirEntLen, i, day); INC(i); FOR j := 0 TO 2 DO monStr[j] := dirEnt[i]; INC(i) END; monStr[3] := 0X; (* Month *) mon := Strings.Pos(monStr, "JANFEBMARAPRMAYJUNJULAUGSEPOCTNOVDEC", 0); IF mon < 0 THEN success := FALSE; RETURN END; mon := mon DIV 3 + 1; INC(i); ScanNumber(dirEnt, dirEntLen, i, year); year := year - 1900; SkipBlanks(dirEnt, dirEntLen, i); ScanNumber(dirEnt, dirEntLen, i, hh); INC(i); ScanNumber(dirEnt, dirEntLen, i, mm); d := ASH(year, 9) + ASH(mon, 5) + day; t := ASH(hh, 12) + ASH(mm, 6); success := TRUE END ScanDate; 8 Syntax10i.Scn.Fnt8Syntax10.Scn.FntSyntax10i.Scn.Fnt jY( :$ + 4) r (* empty line, "total of"-line or other non-direntry? *) (* Valid entries don't start with "Total of" and contain at least one blank *) IF (dirEnt[0] = 0X) OR (Strings.Pos(" ", dirEnt, 0) <= 0) OR (Strings.Pos("Total of", dirEnt, 0) >= 0) THEN elem := NIL; RETURN END; (* Name *) i := 0; WHILE (i < dirEntLen) & (dirEnt[i] # ';') DO name[i] := dirEnt[i]; INC(i) END; name[i] := 0X; (* Skip version no. *) INC(i); ScanNumber(dirEnt, dirEntLen, i, dummy); SkipBlanks(dirEnt, dirEntLen, i); ScanNumber(dirEnt, dirEntLen, i, size); (* Size *) size := size*512; (* the size is given in blocks; one block is 512 bytes *) SkipBlanks(dirEnt, dirEntLen, i); (* Date *) IF i < dirEntLen THEN ScanDate(date, time, success); IF ~success THEN elem := NIL; RETURN END END; SkipBlanks(dirEnt, dirEntLen, i); ScanString(dirEnt, dirEntLen, i, owner); (* Owner *) group := ""; SkipBlanks(dirEnt, dirEntLen, i); ScanString(dirEnt, dirEntLen, i, privs); (* Privs *) elem := NIL; i := Strings.Pos(".DIR", name, 0); IF i >= 0 THEN (* a directory *) name[i] := 0X; NEW(folder); d.CreateDirPath(parent, name, path); InitFolderElem(folder, path, name, parent.pattern, parent.sortOrder, parent.attributes, FALSE); elem := folder ELSE NEW(file); InitFileElem(file, name, parent, size, date, time, privs, owner, group); elem := file; END 8. VAR i, j: INTEGER; file: FileElem; folder: FolderElem; size, date, time, dummy: LONGINT; name, path: FMDevObj.Path; privs, owner, group: ARRAY 32 OF CHAR; PROCEDURE ScanDate(VAR d, t: LONGINT; VAR success: BOOLEAN); BEGIN (* GetVMSDirEntry *) END GetVMSDirEntry; 8`-8<Syntax10.Scn.FntSyntax10i.Scn.FntR8FoldElemsNew{Syntax10.Scn.FntSyntax10i.Scn.Fnt  P M  VAR monStr: ARRAY 4 OF CHAR; year, mon, day, hh, mm: LONGINT; sysTime, sysDate: LONGINT; BEGIN O.GetClock(sysTime, sysDate); FOR j := 0 TO 2 DO monStr[j] := dirEnt[i]; INC(i) END; monStr[3] := 0X; (* Month *) mon := Strings.Pos(monStr, "JanFebMarAprMayJunJulAugSepOctNovDec", 0); IF mon < 0 THEN success := FALSE; RETURN END; mon := mon DIV 3 + 1; SkipBlanks(dirEnt, dirEntLen, i); ScanNumber(dirEnt, dirEntLen, i, day); (* Day *) SkipBlanks(dirEnt, dirEntLen, i); ScanNumber(dirEnt, dirEntLen, i, year); (* Year or Hour *) IF dirEnt[i] = ':' THEN (* Time *) INC(i); hh := year; mm := 0; ScanNumber(dirEnt, dirEntLen, i, mm); (* Minutes *) year := SHORT(ASH(sysDate, -9)); ELSE year := year - 1900; hh := 0; mm := 0; END; d := ASH(year, 9) + ASH(mon, 5) + day; t := ASH(hh, 12) + ASH(mm, 6); IF d > sysDate THEN d := ASH(year - 1, 9) + ASH(mon, 5) + day END; success := TRUE END ScanDate; 8 8Syntax10.Scn.FntaSyntax10i.Scn.FntBO *=_  \<4!Z IF (dirEnt[0] # '-') & (dirEnt[0] # 'd') & (dirEnt[0] # 'l') THEN elem := NIL; RETURN END; (* Privs *) FOR i := 1 TO 9 DO privs[i-1] := dirEnt[i] END; privs[9] := 0X; (* Skip link count *) i := 10; SkipBlanks(dirEnt, dirEntLen, i); (*WHILE (i < dirEntLen) & (dirEnt[i] = ' ') DO INC(i) END;*) IF d.itsSession.remoteType # typeMacOS THEN WHILE (i < dirEntLen) & (dirEnt[i] >= '0') & (dirEnt[i] <= '9') DO INC(i) END; SkipBlanks(dirEnt, dirEntLen, i); END; (* Owner & Group *) ScanString(dirEnt, dirEntLen, i, owner); SkipBlanks(dirEnt, dirEntLen, i); (* Note: The NetPresenz server on the Macintosh writes the string *) (* "folder" instead of an owner name and a group name. *) IF (d.itsSession.remoteType = typeMacOS) & (owner = "folder") THEN COPY("none", group) ELSE ScanString(dirEnt, dirEntLen, i, group); SkipBlanks(dirEnt, dirEntLen, i) END; (* Size *) ScanNumber(dirEnt, dirEntLen, i, size); (* Just for the case we're wrong, search the next space *) WHILE (i < dirEntLen) & (dirEnt[i] # ' ') DO INC(i) END; SkipBlanks(dirEnt, dirEntLen, i); (* Date *) ScanDate(date, time, success); IF ~success THEN elem := NIL; RETURN END; WHILE (i < dirEntLen) & (dirEnt[i] = ' ') DO INC(i) END; (* Name *) j := 0; WHILE (i < dirEntLen) DO name[j] := dirEnt[i]; INC(i); INC(j) END; name[j] := 0X; (* The name might contain a link destination (-> dest) *) k := Strings.Pos(" ->", name, 1); IF k > 0 THEN (* name contains a link dest. *) j := k; WHILE (j >= 0) & (name[j] = ' ') DO DEC(j) END; name[j + 1] := 0X; i := k + 3; j := 0; WHILE name[i] # 0X DO dest[j] := name[i]; INC(i); INC(j) END; dest[j] := 0X; ELSE dest := "n/a" END; elem := NIL; IF dirEnt[0] = "-" THEN (* file entry *) NEW(file); InitFileElem(file, name, parent, size, date, time, privs, owner, group); elem := file; ELSIF dirEnt[0] = "d" THEN (* directory entry *) IF (name # ".") & (name # "..") THEN NEW(folder); d.CreateDirPath(parent, name, path); InitFolderElem(folder, path, name, parent.pattern, parent.sortOrder, parent.attributes, FALSE); elem := folder; END; ELSIF dirEnt[0] = "l" THEN (* symbolic link *) NEW(link); d.CreateDirPath(parent, name, path); InitLinkElem(link, parent, path, dest, name, parent.pattern, parent.sortOrder, parent.attributes, FALSE); elem := link; END;8 (* This actually works for most server types beside UNIX (MacOS, WinNT, ...) *) VAR i, j, k: INTEGER; file: FileElem; folder: FolderElem; link: LinkElem; size, date, time: LONGINT; name, path, dest: FMDevObj.Path; privs, owner, group: ARRAY 32 OF CHAR; PROCEDURE ScanDate(VAR d, t: LONGINT; VAR success: BOOLEAN); BEGIN (* GetUNIXDirEntry *)  END GetUNIXDirEntry; 8\8#Syntax10.Scn.FntKK BEGIN IF s.remoteType = typeVMS THEN IF s.useNLST THEN GetShortVMSDirEntry(dirEnt, dirEntLen, elem) ELSE GetVMSDirEntry(dirEnt, dirEntLen, elem) END ELSE IF s.useNLST THEN GetGenericDirEntry(dirEnt, dirEntLen, elem) ELSE GetUNIXDirEntry(dirEnt, dirEntLen, elem) END END END GetDirEntry; 8Pp8Syntax10.Scn.FntSyntax10i.Scn.Fnt7/Syntax10b.Scn.Fnt 5    '  VAR replyText: T.Writer; replyCode: INTEGER; elem: FMElems.Elem; newElem: T.Elem; dirEnt: ARRAY 256 OF CHAR; dirEntLen: INTEGER; dConn: FTPB.FTPDataConn; listCmd: ARRAY 64 OF CHAR; ch: CHAR; i: INTEGER; n: LONGINT; BEGIN IF s.useNLST THEN listCmd := "NLST" ELSE listCmd := "LIST" END; IF (pattern # "") & (pattern # "*") THEN Strings.Append(" ", listCmd); Strings.Append(pattern, listCmd) END; s.InitiateTransfer(dConn, listCmd, success); IF success THEN (* put dir list into cache *) d.dirCache[cacheEntry].timeStamp := Input.Time(); (* COPY(path, dev.dirCache[cacheEntry].path); compiler bug *) i := 0; WHILE path[i] # 0X DO d.dirCache[cacheEntry].path[i] := path[i]; INC(i) END; d.dirCache[cacheEntry].path[i] := 0X; (* COPY(pattern, dev.dirCache[cacheEntry].pattern); compiler bug *) i := 0; WHILE pattern[i] # 0X DO d.dirCache[cacheEntry].pattern[i] := pattern[i]; INC(i) END; d.dirCache[cacheEntry].pattern[i] := 0X; NEW(d.dirCache[cacheEntry].list); FMDevObj.InitList(d.dirCache[cacheEntry].list, FMDevObj.CompareName); d.dirCache[cacheEntry].valid := TRUE; dirEntLen := 0; dirEnt := ""; n := TCP.Available(dConn); WHILE (n > 0) OR (TCP.Connected(dConn)) DO IF n > 0 THEN TCP.Read(dConn, ch); CASE ch OF 0DX: (* ignore *) | 0AX: dirEnt[dirEntLen] := 0X; LogString(dirEnt, s.logEnable); GetDirEntry(dirEnt, dirEntLen, elem); IF elem # NIL THEN list.Insert(elem); newElem := NIL; elem.Copy(newElem); d.dirCache[cacheEntry].list.Insert(newElem(FMElems.Elem)) END; dirEntLen := 0; ELSE dirEnt[dirEntLen] := ch; INC(dirEntLen) END (* CASE *) END; (* IF *) n := TCP.Available(dConn) END; (* WHILE *) s.cntlConn.WaitForReply(replyCode, replyText); IF s.logEnable THEN T.Append(O.Log, replyText.buf) END ELSE LogError(dataOpenErr) END; dConn.Close() END RetrieveListFromServer; 888#Syntax10.Scn.Fnt VAR elem: FMElems.Elem; iter: FMDevObj.Iterator; file: FileElem; folder: FolderElem; link: LinkElem; BEGIN iter := FMDevObj.NewIterator(d.dirCache[cacheEntry].list); WHILE iter.NextElem(elem) DO IF elem IS LinkElem THEN NEW(link); InitLinkElem(link, parent, elem(LinkElem).path, elem(LinkElem).dest, elem(LinkElem).name, parent.pattern, parent.sortOrder, parent.attributes, FALSE); list.Insert(link); ELSIF elem IS FolderElem THEN NEW(folder); InitFolderElem(folder, elem(FolderElem).path, elem(FolderElem).name, parent.pattern, parent.sortOrder, parent.attributes, FALSE); list.Insert(folder); ELSIF elem IS FileElem THEN NEW(file); InitFileElem(file, elem.name, parent, elem(FileElem).size, elem(FileElem).date, elem(FileElem).time, elem(FileElem).privs, elem(FileElem).owner, elem(FileElem).group); list.Insert(file) END END END RetrieveListFromCache; 8 Syntax10i.Scn.Fnt) VAR s: FTPSession; success: BOOLEAN; file: FileElem; cacheEntry: INTEGER; path: FMDevObj.Path; frame: TextFrames.Frame; PROCEDURE ScanString(dirEnt: ARRAY OF CHAR; dirEntLen: INTEGER; VAR pos: INTEGER; VAR str: ARRAY OF CHAR); PROCEDURE ScanNumber(dirEnt: ARRAY OF CHAR; dirEntLen: INTEGER; VAR pos: INTEGER; VAR num: LONGINT); PROCEDURE SkipBlanks(dirEnt: ARRAY OF CHAR; dirEntLen: INTEGER; VAR pos: INTEGER); PROCEDURE GetGenericDirEntry(dirEnt: ARRAY OF CHAR; dirEntLen: INTEGER; VAR elem: FMElems.Elem); PROCEDURE GetShortVMSDirEntry(dirEnt: ARRAY OF CHAR; dirEntLen: INTEGER; VAR elem: FMElems.Elem); PROCEDURE GetVMSDirEntry(dirEnt: ARRAY OF CHAR; dirEntLen: INTEGER; VAR elem: FMElems.Elem); PROCEDURE GetUNIXDirEntry(dirEnt: ARRAY OF CHAR; dirEntLen: INTEGER; VAR elem: FMElems.Elem); PROCEDURE GetDirEntry(dirEnt: ARRAY OF CHAR; dirEntLen: INTEGER; VAR elem: FMElems.Elem); PROCEDURE RetrieveListFromServer(cacheEntry: INTEGER; path: ARRAY OF CHAR); PROCEDURE RetrieveListFromCache(cacheEntry: INTEGER); BEGIN (* Enumerate *) s := d.itsSession; IF ~s.IsOpen() THEN LogError(noConnectionErr); RETURN END; IF s.curTrans # NIL THEN RETURN END; frame := GetFrameByMouse(); d.GetPath(parent, path); IF (parent IS LinkElem) & (parent(LinkElem).destIsFile) THEN (* The path of a link to a file points to the parent dir of the link, *) (* so we must not search for cache entries (since this would *) (* give us the cache entry of the parent dir. *) success := FALSE ELSE cacheEntry := d.FindCacheEntry(path, pattern, success) END; IF success THEN RetrieveListFromCache(cacheEntry); ELSE IF ~s.Connected(TRUE) THEN RETURN END; IF ((parent IS LinkElem) & ~parent(LinkElem).destIsFile) OR ~(parent IS LinkElem) THEN IF frame # NIL THEN TextFrames.Mark(frame, arrow) END; s.ChangeDir(path, success); IF frame # NIL THEN TextFrames.Mark(frame, position) END; IF ~success THEN (* if its a link, it points to a file *) IF parent IS LinkElem THEN parent(LinkElem).destIsFile := TRUE; ELSE RETURN END END END; IF (parent IS LinkElem) & parent(LinkElem).destIsFile THEN NEW(file); InitFileElem(file, parent.name, parent, 0, 0, 0, "n/a", "n/a", "n/a"); list.Insert(file) ELSE IF frame # NIL THEN TextFrames.Mark(frame, arrow) END; RetrieveListFromServer(cacheEntry, path); IF frame # NIL THEN TextFrames.Mark(frame, position) END END END; END Enumerate; 8@}8CSyntax10.Scn.FntSyntax10i.Scn.FntMA (* Returns always a FileElem with file attributes set to default values. *) VAR e: FMElems.Elem; file: FileElem; folder: FolderElem; path: FMDevObj.Path; BEGIN e := d.itsSession.GetElemHint(); IF e # NIL THEN IF e IS FMElems.FolderElem THEN d.CreateDirPath(parent, name, path); NEW(folder); InitFolderElem(folder, path, name, parent.pattern, parent.sortOrder, parent.attributes, FALSE); RETURN folder ELSE NEW(file); InitFileElem(file, name, parent, e.size, e.date, e.time, "?", "?", "?"); RETURN file END ELSE RETURN NIL END END GetElem; 8 58#Syntax10.Scn.FntII BEGIN WITH folder: FolderElem DO folder.GetPath(path) END END GetPath; 8 N8#Syntax10.Scn.Fnt!! BEGIN RETURN NIL END GetTrash; 8S8#Syntax10.Scn.Fnt88 BEGIN d.Copy(destPar, srcPar, elem, srcDev) END Move; 8 c8#Syntax10.Scn.FntEE BEGIN d.SourceCopy(destPar, srcPar, elem, destDev) END SourceMove; 8V8CSyntax10.Scn.FntSyntax10i.Scn.Fnt (* send file to ftp server *) VAR sysR: FMDevObj.Reader; r: Reader; path: FMDevObj.Path; type: INTEGER; destElem: T.Elem; BEGIN d.done := FALSE; IF d.itsSession.curTrans # NIL THEN RETURN END; srcElem.Copy(destElem); d.itsSession.GetRemoteName(srcElem.name, destElem(FMElems.Elem).name); sysR := srcDev.NewReader(srcPar, srcElem); IF sysR # NIL THEN IF d.itsSession.autoType THEN type := MapSuffix(srcElem.name) ELSE type := d.itsSession.fileType END; IF type = asciiType THEN r := NewAsciiReader(sysR) ELSE r := NewBinaryReader(sysR) END; IF r # NIL THEN d.GetPath(destPar, path); d.InvalidateCacheEntry(path); d.itsSession.EnqueueTransfer(r, srcDev, srcPar, srcElem, d, destPar, destElem(FMElems.Elem), FALSE); d.done := TRUE END; END END Copy; 8 m8CSyntax10.Scn.FntSyntax10i.Scn.Fnt  (* get file from ftp server *) VAR sysW: FMDevObj.Writer; w: Writer; type: INTEGER; destElem: T.Elem; BEGIN d.done := FALSE; IF d.itsSession.curTrans # NIL THEN RETURN END; srcElem.Copy(destElem); d.itsSession.GetLocalName(srcElem.name, destElem(FMElems.Elem).name); sysW := destDev.NewWriter(destParent, destElem(FMElems.Elem)); IF sysW # NIL THEN IF d.itsSession.autoType THEN type := MapSuffix(srcElem.name) ELSE type := d.itsSession.fileType END; IF type = asciiType THEN w := NewAsciiWriter(sysW) ELSE w := NewBinaryWriter(sysW) END; IF w # NIL THEN d.itsSession.EnqueueTransfer(w, destDev, destParent, destElem(FMElems.Elem), d, srcParent, srcElem, FALSE); d.done := TRUE END END END SourceCopy; 8J8#Syntax10.Scn.FntEE BEGIN d.CopyDir(destParent, srcParent, elem, srcDev); END MoveDir; 8 1Y8CSyntax10.Scn.FntSyntax10i.Scn.Fnt=e BEGIN d.done := TRUE (* should return TRUE, otherwise COPY and MOVE won't work *) END MoveToTrash; 8 28_Syntax10.Scn.FntSyntax10i.Scn.Fnt\>]> VAR mkdCmd: ARRAY 256 OF CHAR; path: FMDevObj.Path; replyCode: INTEGER; replyText: T.Writer; msg: FMDevObj.NotifyMsg; folder: FMElems.FolderElem; BEGIN IF d.itsSession.curTrans # NIL THEN d.done := FALSE; RETURN END; (* If the parent is a link and we're not sure if it's destination is a dir, do nothing. *) IF (parent IS LinkElem) & (parent(LinkElem).destIsFile OR ~parent.open) THEN d.done := FALSE; RETURN END; d.GetPath(parent, path); d.Append(path, name); mkdCmd := "MKD "; Strings.Append(path, mkdCmd); LogString(mkdCmd, d.itsSession.logEnable); d.itsSession.cntlConn.Request(mkdCmd, replyCode, replyText); LogBuffer(replyText.buf, d.itsSession.logEnable); d.done := replyCode = 257; IF d.done THEN (* refresh server dir display - broadcast a notification *) d.GetPath(parent, msg.path); d.InvalidateCacheEntry(msg.path); COPY(name, msg.name); msg.devObj := d; msg.id := FMDevObj.insert; NEW(folder); FMElems.InitFolderElem(folder, name, parent.pattern, parent.sortOrder, parent.attributes, FALSE); d.itsSession.SetElemHint(folder); Viewers.Broadcast(msg); d.itsSession.SetElemHint(folder) (* CopyMoveDir calls GetElem immediately after NewDirectory *) END END NewDirectory; 848Syntax10.Scn.Fnts8FoldElemsNew{Syntax10.Scn.FntSyntax10i.Scn.Fnt\2 f  '  (* Open a text viewer containing a "LIST" style directory listing of the specified dir *) VAR replyText: T.Writer; replyCode: INTEGER; dConn: FTPB.FTPDataConn; listCmd: ARRAY 64 OF CHAR; ch: CHAR; n: LONGINT; v: Viewers.Viewer; f: TextFrames.Frame; x, y: INTEGER; dirText: T.Text; w:T.Writer; path: FMDevObj.Path; success: BOOLEAN; BEGIN d.GetPath(parent, path); d.Append(path, srcElem.name); listCmd := "LIST "; Strings.Append(path, listCmd); s.InitiateTransfer(dConn, listCmd, success); IF success THEN NEW(f); dirText := TextFrames.Text(""); TextFrames.Open(f, dirText, 0); O.AllocateUserViewer(O.Mouse.X, x, y); v := MenuViewers.New(TextFrames.NewMenu(path, dirMenu), f, TextFrames.menuH, x, y); T.OpenWriter(w); n := TCP.Available(dConn); WHILE (n > 0) OR (TCP.Connected(dConn)) DO IF n > 0 THEN TCP.Read(dConn, ch); CASE ch OF 0DX: (* ignore *) | 0AX: T.WriteLn(w); T.Append(dirText, w.buf) ELSE T.Write(w, ch) END (* CASE *) END; (* IF *) n := TCP.Available(dConn) END; (* WHILE *) s.cntlConn.WaitForReply(replyCode, replyText); IF s.logEnable THEN T.Append(O.Log, replyText.buf) END ELSE LogError(dataOpenErr) END; dConn.Close() END OpenDirectory; 8$ VAR sysW: FMDevObj.Writer; w: Writer; type: INTEGER; destElem: T.Elem; PROCEDURE OpenDirectory(s: FTPSession); BEGIN IF d.itsSession.curTrans # NIL THEN RETURN END; IF srcElem IS FMElems.FolderElem THEN OpenDirectory(d.itsSession) ELSE srcElem.Copy(destElem); d.itsSession.GetLocalName(srcElem.name, destElem(FMElems.Elem).name); sysW := d.itsSysDevObj.NewWriter(d.downloadsFolder, destElem(FMElems.Elem)); IF d.itsSession.autoType THEN type := MapSuffix(srcElem.name) ELSE type := d.itsSession.fileType END; IF type = asciiType THEN w := NewAsciiWriter(sysW) ELSE w := NewBinaryWriter(sysW) END; IF w # NIL THEN d.itsSession.EnqueueTransfer(w, d.itsSysDevObj, d.downloadsFolder, destElem(FMElems.Elem), d, parent, srcElem, TRUE); END END END Open; 8JI8#Syntax10.Scn.Fnt VAR oldName: FMDevObj.Path; cmd: ARRAY 256 OF CHAR; replyCode: INTEGER; replyText: T.Writer; s: FTPSession; path: FMDevObj.Path; frame: TextFrames.Frame; BEGIN frame := GetFrameByMouse(); IF frame # NIL THEN TextFrames.Mark(frame, arrow) END; s := d.itsSession; d.GetPath(parent, oldName); Strings.Append(elem.name, oldName); cmd := "RNFR "; Strings.Append(oldName, cmd); LogString(cmd, s.logEnable); s.cntlConn.Request(cmd, replyCode, replyText); LogBuffer(replyText.buf, s.logEnable); IF replyCode = 350 THEN cmd := "RNTO "; Strings.Append(name, cmd); LogString(cmd, s.logEnable); s.cntlConn.Request(cmd, replyCode, replyText); LogBuffer(replyText.buf, s.logEnable); d.done := replyCode = 250; IF d.done THEN d.GetPath(parent, path); d.InvalidateCacheEntry(path) END ELSE d.done := FALSE END; IF frame # NIL THEN TextFrames.Mark(frame, position) END END Rename; 8 8Syntax10.Scn.FntI8FoldElemsNew#Syntax10.Scn.FntZZ VAR curr: FMDevObj.Node; success: BOOLEAN; path: FMDevObj.Path; msg: FMDevObj.NotifyMsg; BEGIN curr := root.desc; WHILE curr # NIL DO IF (curr.elem IS FMElems.FolderElem) THEN d.itsSession.RemoveDir(curr.elem(FolderElem).path, success); IF ~success & (curr.elem IS LinkElem) THEN d.GetPath(root.elem(FolderElem), path); Strings.Append(curr.elem.name, path); d.itsSession.DeleteFile(path, success) END ELSE d.GetPath(root.elem(FolderElem), path); Strings.Append(curr.elem.name, path); d.itsSession.DeleteFile(path, success) END; IF success THEN d.GetPath(root.elem(FolderElem), msg.path); d.InvalidateCacheEntry(msg.path); COPY(curr.elem.name, msg.name); msg.devObj := d; msg.id := FMDevObj.remove; Viewers.Broadcast(msg) END; curr := curr.next END END Delete; 8D VAR frame: TextFrames.Frame; PROCEDURE Delete (root: FMDevObj.Node); BEGIN IF Confirm("OK to delete selected items (y/n)?") THEN frame := GetFrameByMouse(); IF frame # NIL THEN TextFrames.Mark(frame, arrow) END; Delete(root); IF frame # NIL THEN TextFrames.Mark(frame, position) END END END DeleteFiles; 8q18#Syntax10.Scn.Fnt BEGIN IF d.itsSession.curTrans # NIL THEN LogError(transmInProgErr); d.done := FALSE; RETURN END; d.CopyMoveFiles^(destParent, srcDev, srcRoot, copy); END CopyMoveFiles; 88_Syntax10.Scn.FntXSyntax10i.Scn.Fnt8} VAR d: Device; f: FolderElem; i: INTEGER; attr: FMElems.Attributes; BEGIN NEW(d); (* Create a device object for the local file system *) NEW(attr.names, 1); attr.nOfAttributes := 0; d.itsSysDevObj := FMSysDevObj.NewDevObj(downloadsPath, d.downloadsFolder, attr, FMDevObj.sortName); (* Set up directory cache *) NEW(d.dirCache, cacheSize); FOR i := 0 TO cacheSize - 1 DO d.dirCache[i].valid := FALSE; d.dirCache[i].timeStamp := 0 END; (* System specialities... *) IF s.remoteType = typeVMS THEN d.delimiter := ":" ELSE d.delimiter := '/' END; d.itsSession := s; NEW(f); InitFolderElem(f, path, fullName, pattern, sortOrder, attributes, FALSE); folder := f; RETURN d END NewDevObj; 88#Syntax10.Scn.Fnt( ( VAR pat: ARRAY 14 OF SET; BEGIN NEW(linkIcon); NEW(linkIcon.pat, 2); pat[0] := {}; pat[1] := {0..12}; pat[2] := {0,12..14}; pat[3] := {0,12, 14}; pat[4] := {0,12, 14}; pat[5] := {0,12, 14}; pat[6] := {0,12, 14}; pat[7] := {0..12, 14}; pat[8] := {0, 6, 8, 14}; pat[9] := {1, 5, 8, 14}; pat[10] := {2..4, 8, 12..14}; pat[11] := {8, 12..13}; pat[12] := {8..12}; linkIcon.pat[0].pat := Display.NewPattern (pat, 15, 12); linkIcon.pat[0].col := black; pat[0] := {}; pat[1] := {}; pat[2] := {1..11}; pat[3] := {1..11, 13}; pat[4] := {1..11}; pat[5] := {1..11, 13}; pat[6] := {1..11}; pat[7] := {13}; pat[8] := {1..5, 10, 12}; pat[9] := {2..4, 9, 11, 13}; pat[10] := {10}; pat[11] := {9, 11}; pat[12] := {}; linkIcon.pat[1].pat := Display.NewPattern (pat, 15, 12); linkIcon.pat[1].col := middlegray; NEW(linkOpenIcon); NEW(linkOpenIcon.pat,3); pat[0] := {}; pat[1] := {0..12}; pat[2] := {0, 13, 14}; pat[3] := {0, 1, 13, 14}; pat[4] := {0,2,14}; pat[5] := {0,3..14}; pat[6] := {0, 12, 14}; pat[7] := {0, 7..12, 14}; pat[8] := {0, 6, 8, 14}; pat[9] := {1, 5, 8, 14}; pat[10] := {2..4, 8, 12..14}; pat[11] := {8, 12, 13}; pat[12] := {8..12}; linkOpenIcon.pat[0].pat := Display.NewPattern (pat, 15, 12); linkOpenIcon.pat[0].col := black; pat[0] := {}; pat[1] := {}; pat[2] := {}; pat[3] := {}; pat[4] := {1}; pat[5] := {1, 2}; pat[6] := {1..11}; pat[7] := {1..6}; pat[8] := {1..5}; pat[9] := {2..4}; pat[10] := {}; pat[11] := {}; pat[12] := {}; linkOpenIcon.pat[1].pat := Display.NewPattern (pat, 15, 12); linkOpenIcon.pat[1].col := lightgray; pat[0] := {}; pat[1] := {}; pat[2] := {1..12}; pat[3] := {2..12}; pat[4] := {3..13}; pat[5] := {13}; pat[6] := {}; pat[7] := {13}; pat[8] := {10, 12}; pat[9] := {9, 11, 13}; pat[10] := {10}; pat[11] := {9, 11}; pat[12] := {}; linkOpenIcon.pat[2].pat := Display.NewPattern (pat, 15, 12); linkOpenIcon.pat[2].col := darkgray; NEW(linkIcon.selPat, 2); linkIcon.selPat^[0] := linkIcon.pat^[0]; linkIcon.selPat[1].pat := linkIcon.pat[1].pat; linkIcon.selPat[1].col := darkgray; NEW(linkOpenIcon.selPat,3); linkOpenIcon.selPat^[0] := linkOpenIcon.pat^[0]; linkOpenIcon.selPat[1].pat := linkOpenIcon.pat[1].pat; linkOpenIcon.selPat[1].col := darkgray; linkOpenIcon.selPat[2].pat := linkOpenIcon.pat[2].pat; linkOpenIcon.selPat[2].col := black END Init; 84k8#Syntax10.Scn.Fntss BEGIN WHILE ~r.eot & ((ch = ' ') OR (ch = 0AX) OR (ch = 0DX) OR (ch = 09X)) DO T.Read(r, ch) END END SkipBlanks; 88qSyntax10.Scn.Fnt*Syntax10b.Scn.Fnt6Syntax10i.Scn.Fnt VAR i: INTEGER; PROCEDURE IsDelimiter(ch: CHAR): BOOLEAN; VAR i: INTEGER; BEGIN IF inclBlanks & ((ch = ' ') OR (ch = 0AX) OR (ch = 0DX) OR (ch = 09X)) THEN RETURN TRUE END; i := 0; WHILE delimChars[i] # 0X DO IF delimChars[i] = ch THEN RETURN TRUE ELSE INC(i) END END; RETURN FALSE; END IsDelimiter; BEGIN i := 0; IF (ch = '"') THEN (* Read quoted string *) T.Read(r, ch); WHILE ~r.eot & (i < LEN(arg) - 1) & (ch # '"') & (ch # 0AX) & (ch # 0DX) DO arg[i] := ch; INC(i); T.Read(r, ch) END; IF ch = '"' THEN T.Read(r, ch) END; ELSE (* Read to next delimiter *) WHILE ~r.eot & (i < LEN(arg) - 1) & ~IsDelimiter(ch) DO arg[i] := ch; INC(i); T.Read(r, ch) END END; arg[i] := 0X END ReadArg; 8N8_Syntax10.Scn.FntSyntax10i.Scn.Fnt= (* Opens a reader for readings arguments from O.Par.text. *) (* If the first non-blank char is a '^', the reader is re-opened *) (* for the most recent selection. Ch contains the first char of the first argument. *) VAR text: T.Text; beg, end, time: LONGINT; BEGIN success := TRUE; T.OpenReader(r, O.Par.text, O.Par.pos); T.Read(r, ch); SkipBlanks(r, ch); IF ~r.eot THEN IF ch = '^' THEN (* Params are in selection *) O.GetSelection(text, beg, end, time); IF time > 0 THEN (* the selection exists *) T.OpenReader(r, text, beg); T.Read(r, ch); SkipBlanks(r, ch) ELSE LogString("No selection.", TRUE); success := FALSE END END ELSE LogString("No parameters.", TRUE); success := FALSE END END GetArgsReader; 8)8Syntax10.Scn.FntSyntax10i.Scn.Fnt#hG8FoldElemsNew#Syntax10.Scn.Fnt BEGIN FindProfile(profile, sec, ent, success, s); IF success THEN T.Scan(s); val := (s.class = T.Name) & (s.s = "TRUE") END END GetProfBool; 8IA8#Syntax10.Scn.Fnt BEGIN FindProfile(profile, sec, ent, success, s); IF success THEN T.Scan(s); IF (s.class = T.Name) THEN COPY(s.s, val) END END END GetProfName; 8H@8#Syntax10.Scn.Fnt BEGIN FindProfile(profile, sec, ent, success, s); IF success THEN T.Scan(s); IF (s.class = T.String) THEN COPY(s.s, val) END END END GetProfStr; 8  (* Interprets the user profile *) VAR success: BOOLEAN; s: T.Scanner; PROCEDURE GetProfBool(sec, ent: ARRAY OF CHAR; VAR val: BOOLEAN); PROCEDURE GetProfName(sec, ent: ARRAY OF CHAR; VAR val: ARRAY OF CHAR); PROCEDURE GetProfStr(sec, ent: ARRAY OF CHAR; VAR val: ARRAY OF CHAR); BEGIN (* defaults *) prof.ftp.type := autoType; prof.ftp.logging := FALSE; prof.ftp.useNLST := FALSE; prof.display.date := TRUE; prof.display.size := TRUE; prof.display.links := TRUE; prof.display.privs := FALSE; prof.display.owner := FALSE; prof.display.sort := "name"; prof.user.downloadsFolder := "$*"; prof.user.mail := ""; FindProfile(profile, "FTP", "Type", success, s); IF success THEN T.Scan(s); IF (s.class = T.Name) & (s.s = "ASCII") THEN prof.ftp.type := asciiType ELSIF (s.class = T.Name) & (s.s = "Binary") THEN prof.ftp.type := binaryType ELSIF (s.class = T.Name) & (s.s = "Automatic") THEN prof.ftp.type := autoType END END; GetProfBool("FTP", "Logging", prof.ftp.logging); GetProfBool("FTP", "UseNLST", prof.ftp.useNLST); GetProfBool("Display", "Date", prof.display.date); GetProfBool("Display", "Size", prof.display.size); GetProfBool("Display", "Links", prof.display.links); GetProfBool("Display", "Privs", prof.display.privs); GetProfBool("Display", "Owner", prof.display.owner); GetProfName("Display", "Sort", prof.display.sort); GetProfStr("User", "DownloadsFolder", prof.user.downloadsFolder); GetProfStr("User", "Mail", prof.user.mail); END GetProfile; 8u_8VSyntax10.Scn.FntM8FoldElemsNewCSyntax10.Scn.FntxSyntax10b.Scn.Fntq VAR i, j: INTEGER; names: FMElems.AttributeNames; BEGIN NEW(names, attributes.nOfAttributes + 1); FOR i := 0 TO attributes.nOfAttributes - 1 DO (* COPY(attributes.names[i], names[i])*) j := 0; WHILE attributes.names[i][j] # 0X DO names[i][j] :=attributes.names[i][j]; INC(j) END; names[i][j] := 0X; END; (*COPY(name, names[attributes.nOfAttributes]); <== does not work, compiler bug *) i := 0; WHILE name[i] # 0X DO names[attributes.nOfAttributes][i] := name[i]; INC(i) END; names[attributes.nOfAttributes][i] := 0X; attributes.names := names; INC(attributes.nOfAttributes) END AppendAttribute; 8Syntax10i.Scn.FntS a  VAR curr: FMDevObj.Node; f, folder: FMElems.FolderElem; i, j: INTEGER; dev: FMDevObj.Device; path: ARRAY 256 OF CHAR; PROCEDURE AppendAttribute(VAR attributes: FMElems.Attributes; VAR name: ARRAY OF CHAR); BEGIN IF root.desc = NIL THEN folder := root.elem(FMElems.FolderElem); IF id = selectCmd THEN FMFrames.SelectFiles(t, folder, name) ELSE IF (id = sortCmd) & (name # "") THEN COPY(name, folder.sortOrder) ELSIF id = viewCmd THEN COPY(name, folder.pattern) ELSIF id = switchAttributesCmd THEN i := 0; WHILE (i < folder.attributes.nOfAttributes) & (folder.attributes.names[i] # name) DO INC(i) END; IF i < folder.attributes.nOfAttributes THEN (* attribute found *) f := FMFrames.GetEnclosingFolder(t, T.ElemPos(folder)); IF f # NIL THEN folder.attributes.names[i] := 0X ELSE DEC(folder.attributes.nOfAttributes); FOR j := i TO folder.attributes.nOfAttributes - 1 DO folder.attributes.names[j] := folder.attributes.names[j+1] END END ELSE (* attribute is not contained *) f := FMFrames.GetEnclosingFolder(t, T.ElemPos(folder)); IF f # NIL THEN i := 0; WHILE (i < f.attributes.nOfAttributes) & (f.attributes.names[i] # name) DO INC(i) END; IF i < f.attributes.nOfAttributes THEN (* attribute found *) COPY(name, folder.attributes.names[i]) ELSE AppendAttribute(folder.attributes, name) (* attribute is not contained *) END ELSE AppendAttribute(folder.attributes, name) END END ELSIF id = refreshCmd THEN dev := t.devObj; WITH dev: Device DO folder(FolderElem).GetPath(path); dev.InvalidateCacheEntry(path) END; END; IF folder.open THEN FMFrames.SwitchFolder(t, folder); FMFrames.SwitchFolder(t, folder) END END ELSE curr := root.desc; WHILE curr # NIL DO Change(t, id, curr, name); curr := curr.next END END END Change; 89i8 Syntax10.Scn.FntO8FoldElemsNew#Syntax10.Scn.Fnt VAR root, curr, node: FMDevObj.Node; elem: T.Elem; BEGIN root := NIL; T.ReadElem(r); elem := r.elem; WHILE (elem # NIL) & ~(elem IS FMFrames.EndMarker) DO IF (elem IS FMElems.FolderElem) THEN NEW(node); node.next := NIL; node.desc := NIL; node.elem := elem(FMElems.Elem); IF ~node.elem.selected & elem(FMElems.FolderElem).open THEN node.desc := GetSelectedDirs() END; IF node.elem.selected OR (node.desc # NIL) THEN IF root = NIL THEN curr := node; root := node ELSE curr.next := node; curr := node END END END; T.ReadElem(r); elem := r.elem END; RETURN root END GetSelectedDirs; 8 VAR frame: TextFrames.Frame; root: FMDevObj.Node; r: T.Reader; dev: FMDevObj.Device; path: ARRAY 256 OF CHAR; PROCEDURE GetSelectedDirs(): FMDevObj.Node; BEGIN frame := GetSessionFrame(); IF frame # NIL THEN T.OpenReader(r, frame.text, 0); root := GetSelectedDirs(); IF root # NIL THEN IF id = setDirCmd THEN dev := frame.text(FMFrames.Text).devObj; WITH dev: Device DO root.elem(FolderElem).GetPath(path); END; ELSE FMFrames.RemoveFocus(frame); Change(frame.text(FMFrames.Text), id, root, param); IF id # selectCmd THEN FMFrames.RemoveSelection(frame) END END END END END ExecuteCmd; 8 8#Syntax10.Scn.Fnt VAR r: T.Reader; ch: CHAR; attr: ARRAY 16 OF CHAR; success: BOOLEAN; BEGIN GetArgsReader(r, ch, success); IF success THEN ReadArg(r, ch, "~", attr, TRUE) ELSE RETURN END; ExecuteCmd(switchAttributesCmd, attr) END SwitchAttribute; 8 8#Syntax10.Scn.Fnt VAR r: T.Reader; ch: CHAR; sortOrder: ARRAY 16 OF CHAR; success: BOOLEAN; BEGIN GetArgsReader(r, ch, success); IF success THEN ReadArg(r, ch, "~", sortOrder, TRUE) ELSE RETURN END; ExecuteCmd(sortCmd, sortOrder) END Sort; 8 8#Syntax10.Scn.Fnt VAR r: T.Reader; ch: CHAR; pattern: ARRAY 16 OF CHAR; success: BOOLEAN; BEGIN GetArgsReader(r, ch, success); IF success THEN ReadArg(r, ch, "~", pattern, TRUE) ELSE RETURN END; ExecuteCmd(viewCmd, pattern) END View; 8 8#Syntax10.Scn.Fnt00 BEGIN ExecuteCmd(refreshCmd, "") END Refresh; 8 i8#Syntax10.Scn.Fntuu VAR s: FTPSession; BEGIN s := GetSession(); s.ToggleUseNLST(); ExecuteCmd(refreshCmd, "") END ToggleListMethod; 8  8#Syntax10.Scn.FntNN VAR s: FTPSession; BEGIN s := GetSession(); s.ToggleLog(); END ToggleLog; 8 Zr8QSyntax10.Scn.FntSyntax10i.Scn.Fnt93.> (* Converts the host address string to an IP address. *) BEGIN IF (host[0] >= '0') & (host[0] <= '9') THEN (* host address in dotted-decimal notation *) TCP.HostByNumber(host, hostAddr, res) ELSE TCP.HostByName(host, hostAddr, res) END; IF res # TCP.Done THEN LogError(resolveErr) END END ResolveAddress; 8.8Syntax10.Scn.FntkpVersionElemsAllocBeg#Syntax10.Scn.FntPowerMac Windows Windows31WindowsPowerMac#Syntax10.Scn.Fnt T.WriteInt(w, SYSTEM.LSH(hostAddr, -24), 0); T.Write(w, '.'); T.WriteInt(w, SYSTEM.LSH(hostAddr, -16) MOD 256, 0); T.Write(w, '.'); T.WriteInt(w, SYSTEM.LSH(hostAddr, -8) MOD 256, 0); T.Write(w, '.'); T.WriteInt(w, hostAddr MOD 256, 0); Windows Windows31#Syntax10.Scn.Fnt T.WriteInt(w, hostAddr MOD 256, 0); T.Write(w, '.'); T.WriteInt(w, SYSTEM.LSH(hostAddr, -8) MOD 256, 0); T.Write(w, '.'); T.WriteInt(w, SYSTEM.LSH(hostAddr, -16) MOD 256, 0); T.Write(w, '.'); T.WriteInt(w, SYSTEM.LSH(hostAddr, -24), 0); pVersionElemsAllocEnd BEGIN  T.WriteInt(w, hostAddr MOD 256, 0); T.Write(w, '.'); T.WriteInt(w, SYSTEM.LSH(hostAddr, -8) MOD 256, 0); T.Write(w, '.'); T.WriteInt(w, SYSTEM.LSH(hostAddr, -16) MOD 256, 0); T.Write(w, '.'); T.WriteInt(w, SYSTEM.LSH(hostAddr, -24), 0);  END WriteHostAddr; 8 8Syntax10.Scn.FntSyntax10i.Scn.FntCJ(*v)P0"VIc n (* Parse the arguments and open a connection to the FTP server *) VAR r: T.Reader; success: BOOLEAN; ch: CHAR; host, dir, uid, pwd, acct: ARRAY 256 OF CHAR; hostAddr: TCP.IpAdr; dottedAddr: BOOLEAN; res: INTEGER; fullName: FMDevObj.Path; folder: FMElems.FolderElem; attributes: FMElems.Attributes; dev: FMDevObj.Device; x, y: INTEGER; v: Viewers.Viewer; path: FMDevObj.Path; s: FTPSession; prof: Profile; BEGIN dir := ""; uid := ""; pwd := ""; acct := ""; GetArgsReader(r, ch, success); IF success THEN (* host name or ip number *) ReadArg(r, ch, "~/", host, TRUE); SkipBlanks(r, ch); IF ch = '/' THEN (* there's a dir specified *) T.Read(r, ch); ReadArg(r, ch, "~", dir, TRUE) END; SkipBlanks(r, ch); ReadArg(r, ch, "~", uid, TRUE); SkipBlanks(r, ch); ReadArg(r, ch, "~", pwd, TRUE); SkipBlanks(r, ch); ReadArg(r, ch, "~", acct, TRUE); ELSE RETURN; END; (* Read the user profile *) GetProfile(prof); (* Check if downloads folder exists *) IF Directories.This(prof.user.downloadsFolder) = NIL THEN Directories.Create(prof.user.downloadsFolder); T.WriteString(w, "The downloads folder has been created."); T.WriteLn(w); LogBuffer(w.buf, TRUE) END; (* Complete the downloads folder name *) Strings.Append(Directories.delimiter, prof.user.downloadsFolder); Strings.Append("*", prof.user.downloadsFolder); (* Open the connection to the server *) ResolveAddress(host, hostAddr, res); IF res # TCP.Done THEN RETURN END; dottedAddr := (host[0] >= '0') & (host[0] <= '9'); T.WriteString(w, "Connecting to "); IF ~dottedAddr THEN T.WriteString(w, host); T.WriteString(w, " (") END; WriteHostAddr(hostAddr); IF ~dottedAddr THEN T.WriteString(w, ")") END; T.WriteString(w, "..."); T.WriteLn(w); LogBuffer(w.buf, TRUE); IF uid = "" THEN uid := "anonymous"; COPY(prof.user.mail, pwd); END; NEW(s); s.Open(hostAddr, uid, pwd, acct, prof.ftp.logging, prof.ftp.useNLST, prof.ftp.type, success); IF ~success THEN RETURN END; IF dir # "" THEN s.ChangeDir(dir, success) END; (* Change directory *) s.GetDir(fullName, success); (* Get the CWD from the server *) IF success THEN path := fullName; IF path[Strings.Length(path) - 1] # '/' THEN (* We have to consider VMS's ill directory specification scheme... *) IF s.remoteType # typeVMS THEN Strings.Append("/", path) END END ELSE path := "/" END; (* Viewer *) NEW(attributes.names, 5); attributes.nOfAttributes := 0; IF prof.display.date THEN attributes.names[attributes.nOfAttributes] := "date"; INC(attributes.nOfAttributes) END; IF prof.display.size THEN attributes.names[attributes.nOfAttributes] := "size"; INC(attributes.nOfAttributes) END; IF prof.display.links THEN attributes.names[attributes.nOfAttributes] := "links"; INC(attributes.nOfAttributes) END; IF prof.display.privs THEN attributes.names[attributes.nOfAttributes] := "privs"; INC(attributes.nOfAttributes) END; IF prof.display.owner THEN attributes.names[attributes.nOfAttributes] := "owner"; INC(attributes.nOfAttributes) END; dev := NewDevObj(fullName, path, folder, attributes, prof.display.sort, "*", s, prof.user.downloadsFolder); IF dev = NIL THEN s.Close(); RETURN END; O.AllocateUserViewer(O.Par.vwr.X, x, y); dev.GetPath(folder, path); v := MenuViewers.New(TextFrames.NewMenu(host, menu), FMFrames.NewFrame(NewText(dev, folder, s)), TextFrames.menuH, x, y); END Open; 8 S8#Syntax10.Scn.Fnt VAR frame: TextFrames.Frame; msg: FMFrames.CopyMoveMsg; BEGIN frame := GetSessionFrame(); IF frame # NIL THEN TextFrames.Mark(frame, arrow); msg.root := FMFrames.GetSelectedElems(frame.text(FMFrames.Text)); msg.devObj := frame.text(FMFrames.Text).devObj; msg.id := FMFrames.copy; IF msg.root # NIL THEN Viewers.Broadcast(msg) END; TextFrames.Mark(frame, position) END END Copy; 8 8#Syntax10.Scn.Fnt VAR s: FTPSession; ch: CHAR; r: T.Reader; name: ARRAY 32 OF CHAR; success: BOOLEAN; BEGIN s := GetSession(); GetArgsReader(r, ch, success); IF success THEN ReadArg(r, ch, "~", name, TRUE) ELSE RETURN END; s.SetLocalName(name); Copy(); END CopyTo; 8  `8#Syntax10.Scn.Fnt~~ VAR r: T.Reader; ch: CHAR; name: ARRAY 32 OF CHAR; success: BOOLEAN; frame: TextFrames.Frame; BEGIN frame := GetSessionFrame(); IF frame # NIL THEN TextFrames.Mark(frame, arrow); GetArgsReader(r, ch, success); IF success THEN ReadArg(r, ch, "~", name, TRUE) ELSE RETURN END; FMFrames.NewDir(frame, name); TextFrames.Mark(frame, position) END END NewFolder; 8 N8#Syntax10.Scn.Fnt VAR frame: TextFrames.Frame; BEGIN frame := GetSessionFrame(); IF frame # NIL THEN FMFrames.DeleteSelectedFiles(frame); END END Delete; 8 8CSyntax10.Scn.FntSyntax10i.Scn.Fnt> (* Sends the argument to the server and prints the reply. *) VAR r: T.Reader; s: FTPSession; frame: TextFrames.Frame; cmdStr: ARRAY 256 OF CHAR; ch: CHAR; success: BOOLEAN; replyCode: INTEGER; replyText: T.Writer; BEGIN GetArgsReader(r, ch, success); IF success THEN ReadArg(r, ch, "~", cmdStr, FALSE) ELSE RETURN END; s := GetSession(); IF s = NIL THEN RETURN END; frame := GetSessionFrame(); TextFrames.Mark(frame, arrow); IF s.logEnable THEN LogString(cmdStr, s.logEnable) END; s.cntlConn.Request(cmdStr, replyCode, replyText); IF replyCode # FTPB.replyCodeTimeOut THEN LogBuffer(replyText.buf, TRUE) ELSE LogError(replyTimeOutErr) END; TextFrames.Mark(frame, position) END SendCmd; 8'r8CSyntax10.Scn.FntSyntax10i.Scn.FntJL VAR s: FTPSession; success: BOOLEAN; frame: TextFrames.Frame; BEGIN s := GetSession(); IF s = NIL THEN RETURN END; frame := GetSessionFrame(); TextFrames.Mark(frame, arrow); IF s.curTrans # NIL THEN LogError(transmInProgErr); RETURN END; s.SetFileType(type, success); TextFrames.Mark(frame, position) END SetFileType; 8 m8CSyntax10.Scn.FntSyntax10i.Scn.Fnt&)Q (* Sets the transfer type to ASCII *) BEGIN SetFileType(asciiType) END ASCII; 8 j8CSyntax10.Scn.FntSyntax10i.Scn.Fnt'+T (* Sets the transfer type to binary *) BEGIN SetFileType(binaryType) END Binary; 8  i8CSyntax10.Scn.FntSyntax10i.Scn.Fnt',U (* Sets the transfer type to binary *) BEGIN SetFileType(autoType) END Automatic; 8 C8CSyntax10.Scn.FntSyntax10i.Scn.Fnt*O{ (* Prints some connection information *) VAR s: FTPSession; i, bps: REAL; BEGIN s := GetSession(); IF s = NIL THEN RETURN END; T.WriteString(w, "FTP Status:"); T.WriteLn(w); T.WriteString(w, "Connected to: "); WriteHostAddr(s.hostAddr); T.WriteLn(w); T.WriteString(w, "Remote system type: "); IF s.remoteType = "" THEN T.WriteString(w, "(unknown)") ELSE T.WriteString(w, s.remoteType) END; T.WriteLn(w); T.WriteString(w, "List method: "); IF s.useNLST THEN T.WriteString(w, "NLST") ELSE T.WriteString(w, "LIST") END; T.WriteLn(w); T.WriteString(w, "File type: "); IF s.fileType = asciiType THEN T.WriteString(w, "ASCII") ELSE T.WriteString(w, "Binary") END; IF s.autoType THEN T.WriteString(w, " (Automatic)") END; T.WriteLn(w); IF s.curTrans # NIL THEN i := (O.Time() - s.curTrans.startTime)/Input.TimeUnit; IF i = 0 THEN i := 1 END; T.WriteString(w, "Current file transfer: "); T.WriteInt(w, s.curTrans.bytesTransferred, 0); IF s.curTrans.fileSize > 0 THEN T.WriteString(w, " of "); T.WriteInt(w, s.curTrans.fileSize, 0); T.WriteString(w, " bytes ("); T.WriteRealFix(w, s.curTrans.bytesTransferred * 100.0 / s.curTrans.fileSize, 0, 1); T.WriteString(w, " %)") ELSE T.WriteString(w, " bytes") END; T.WriteString(w, " in "); T.WriteRealFix(w, i, 0, 1); T.WriteString(w, " sec. = "); bps := s.curTrans.bytesTransferred/i; IF bps < 1024 THEN T.WriteRealFix(w, bps, 0, 1) ELSE T.WriteRealFix(w, bps/1024, 0, 1); T.WriteString(w, "K") END; T.WriteString(w, " bytes/sec."); T.WriteLn(w); ELSE T.WriteString(w, "No file transfer."); T.WriteLn(w); END; T.Append(O.Log, w.buf) END Status; 8 8CSyntax10.Scn.FntSyntax10i.Scn.FntH& (* Sends an ABOR command to the server and aborts any data transfer *) VAR s: FTPSession; frame: TextFrames.Frame; BEGIN s := GetSession(); IF s = NIL THEN RETURN END; frame := GetSessionFrame(); TextFrames.Mark(frame, arrow); s.Abort(); TextFrames.Mark(frame, position) END Abort; 8%MODULE FTP; (** A File Transfer Protocol client based upon the FileManager framework **) (** By Gnter Obiltschnig (g.obiltschnig@jk.uni-linz.ac.at) **) (* Compile for Windows 95/NT *)  Revision History IMPORT CONST TYPE VAR (*********** FTPSession ***********) (* Finalizer *) PROCEDURE Finalizer(obj: SYSTEM.PTR); (* Text *) PROCEDURE NewText(devObj: FMDevObj.Device; folder: FMElems.FolderElem; s: FTPSession): Text; (* Misc. utility procedures *) PROCEDURE WriteString(str: ARRAY OF CHAR); PROCEDURE WriteLn; PROCEDURE LogBuffer(buf: T.Buffer; enable: BOOLEAN); PROCEDURE LogString(msg: ARRAY OF CHAR; enable: BOOLEAN); PROCEDURE LogError(errNo: INTEGER); PROCEDURE ReadPassword(prompt: ARRAY OF CHAR; VAR passwd: ARRAY OF CHAR); PROCEDURE Confirm(prompt: ARRAY OF CHAR): BOOLEAN; PROCEDURE FindProfile(profile, section, attr: ARRAY OF CHAR; VAR success: BOOLEAN; VAR s: T.Scanner); PROCEDURE MapSuffix(name: ARRAY OF CHAR): INTEGER; PROCEDURE ReplyToString(replyText: T.Writer; VAR replyString: ARRAY OF CHAR); (* Session Handling *) PROCEDURE GetSession(): FTPSession; PROCEDURE GetSessionFrame(): TextFrames.Frame; PROCEDURE GetFrameByMouse(): TextFrames.Frame; PROCEDURE (s: FTPSession) ToggleUseNLST(); PROCEDURE (s: FTPSession) ToggleLog(); PROCEDURE (s: FTPSession) IsOpen(): BOOLEAN; PROCEDURE (s: FTPSession) Req(req: ARRAY OF CHAR; VAR replyCode: INTEGER; VAR replyText: T.Writer); PROCEDURE (s: FTPSession) Do(dir: ARRAY OF CHAR; cmd: ARRAY OF CHAR; VAR success: BOOLEAN); PROCEDURE (s: FTPSession) ChangeDir(dir: ARRAY OF CHAR; VAR success: BOOLEAN); PROCEDURE (s: FTPSession) RemoveDir(dir: ARRAY OF CHAR; VAR success: BOOLEAN); PROCEDURE (s: FTPSession) DeleteFile(file: ARRAY OF CHAR; VAR success: BOOLEAN); PROCEDURE (s: FTPSession) GetDir(VAR dir: ARRAY OF CHAR; VAR success: BOOLEAN); PROCEDURE (s: FTPSession) SendTypeCmd(type: INTEGER; VAR success: BOOLEAN); PROCEDURE (s: FTPSession) SetFileType(type: INTEGER; VAR success: BOOLEAN); PROCEDURE (s: FTPSession) WinNTSetUNIXFormat(); PROCEDURE (s: FTPSession) GetSystemType(VAR type: ARRAY OF CHAR); PROCEDURE (s: FTPSession) ReOpen(VAR success: BOOLEAN); PROCEDURE (s: FTPSession) Open(hostAddr: TCP.IpAdr; uid, pwd, acct: ARRAY OF CHAR; logEnable, useNLST: BOOLEAN; fileType: INTEGER; VAR success: BOOLEAN); PROCEDURE (s: FTPSession) Close(); PROCEDURE (s: FTPSession) Connected(reconnect: BOOLEAN): BOOLEAN; PROCEDURE (s: FTPSession) Abort(); PROCEDURE (s: FTPSession) SetElemHint(elem: FMElems.Elem); PROCEDURE (s: FTPSession) GetElemHint(): FMElems.Elem; PROCEDURE (s: FTPSession) SetLocalName(name: ARRAY OF CHAR); PROCEDURE (s: FTPSession) GetLocalName(remoteName: ARRAY OF CHAR; VAR localName: ARRAY OF CHAR); PROCEDURE (s: FTPSession) GetRemoteName(localName: ARRAY OF CHAR; VAR remoteName: ARRAY OF CHAR); (* Reader, Writer *) PROCEDURE (w: Writer) Close*(); PROCEDURE (r: BinaryReader) GetBytes*(VAR buffer: ARRAY OF CHAR; VAR len: INTEGER); PROCEDURE (w: BinaryWriter) PutBytes*(VAR buffer: ARRAY OF CHAR; VAR len: INTEGER); PROCEDURE (r: AsciiReader) GetBytes*(VAR buffer: ARRAY OF CHAR; VAR len: INTEGER); PROCEDURE (w: AsciiWriter) PutBytes*(VAR buffer: ARRAY OF CHAR; VAR len: INTEGER); PROCEDURE NewBinaryReader(sysReader: FMDevObj.Reader): BinaryReader; PROCEDURE NewBinaryWriter(sysWriter: FMDevObj.Writer): BinaryWriter; PROCEDURE NewAsciiReader(sysReader: FMDevObj.Reader): AsciiReader; PROCEDURE NewAsciiWriter(sysWriter: FMDevObj.Writer): AsciiWriter; (* File Transfers *) PROCEDURE (s: FTPSession) InitiateTransfer(VAR d: FTPB.FTPDataConn; cmd: ARRAY OF CHAR; VAR success: BOOLEAN); PROCEDURE (s: FTPSession) AdjustType(path: ARRAY OF CHAR; VAR success: BOOLEAN); PROCEDURE (s: FTPSession) GetFile(q: TransferQueue; writer: Writer); PROCEDURE (s: FTPSession) PutFile(q: TransferQueue; reader: Reader); PROCEDURE (s: FTPSession) StartTransfers; PROCEDURE StartTransfersHandler(); PROCEDURE (s: FTPSession) EnqueueTransfer(rw: FTPB.ReaderWriter; localDev: FMDevObj.Device; localParent: FMElems.FolderElem; localFile: FMElems.Elem; remoteDev: FMDevObj.Device; remoteParent: FMElems.FolderElem; remoteFile: FMElems.Elem; open: BOOLEAN); (* FTPTransmission *) PROCEDURE (t: FTPTransmission) Completed*(success: BOOLEAN); (*********** FTPDevObj ***********) (* File-Element *) PROCEDURE (e: FileElem) Copy*(VAR de: T.Elem); PROCEDURE (e: FileElem) WriteAttribute*(VAR w: T.Writer; VAR name: FMElems.AttributeName); PROCEDURE (e: FileElem) GetAttributeWidth*(VAR width: LONGINT; VAR name: FMElems.AttributeName); PROCEDURE InitFileElem(e: FileElem; name: ARRAY OF CHAR; parent: FMElems.FolderElem; size, date, time: LONGINT; privs, owner, group: ARRAY OF CHAR); (* Folder-Element *) PROCEDURE (f: FolderElem) Copy*(VAR de: T.Elem); PROCEDURE (f: FolderElem) GetPath*(VAR path: ARRAY OF CHAR); PROCEDURE InitFolderElem(f: FolderElem; path, name, pattern, sortOrder: ARRAY OF CHAR; VAR attributes: FMElems.Attributes; open: BOOLEAN); (* Link-Element *) PROCEDURE (l: LinkElem) Copy*(VAR de: T.Elem); PROCEDURE (l: LinkElem) GetPath*(VAR path: ARRAY OF CHAR); PROCEDURE (l: LinkElem) WriteAttribute*(VAR w: T.Writer; VAR name: FMElems.AttributeName); PROCEDURE InitLinkElem(l: LinkElem; parent: FMElems.FolderElem; path, dest, name, pattern, sortOrder: ARRAY OF CHAR; VAR attributes: FMElems.Attributes; open: BOOLEAN); (* Device-Object *) PROCEDURE (d: Device) CreateDirPath(par: FMElems.FolderElem; name: ARRAY OF CHAR; VAR path: ARRAY OF CHAR); PROCEDURE (d: Device) FindCacheEntry(path, pattern: ARRAY OF CHAR; VAR found: BOOLEAN): INTEGER; PROCEDURE (d: Device) InvalidateCacheEntry(path: ARRAY OF CHAR); PROCEDURE (d: Device) NeedCopyMoveControl*(): BOOLEAN; PROCEDURE (d: Device) Append*(VAR path: ARRAY OF CHAR; name: ARRAY OF CHAR); PROCEDURE (d: Device) CheckIdentity*(elem: FMElems.Elem; name: ARRAY OF CHAR): BOOLEAN; PROCEDURE (d: Device) Enumerate*(parent: FMElems.FolderElem; list: FMDevObj.List; pattern: ARRAY OF CHAR); PROCEDURE (d: Device) GetElem*(parent: FMElems.FolderElem; name: ARRAY OF CHAR): FMElems.Elem; PROCEDURE (d: Device) GetPath*(folder: FMElems.FolderElem; VAR path: ARRAY OF CHAR); PROCEDURE (d: Device) GetTrash*(VAR attrs: FMElems.Attributes; sortOrder: ARRAY OF CHAR): FMElems.FolderElem; PROCEDURE (d: Device) Move*(destPar, srcPar: FMElems.FolderElem; elem: FMElems.Elem; srcDev: FMDevObj.Device); PROCEDURE (d: Device) SourceMove*(destPar, srcPar: FMElems.FolderElem; elem: FMElems.Elem; destDev: FMDevObj.Device); PROCEDURE (d: Device) Copy*(destPar, srcPar: FMElems.FolderElem; srcElem: FMElems.Elem; srcDev: FMDevObj.Device); PROCEDURE (d: Device) SourceCopy*(destParent, srcParent: FMElems.FolderElem; srcElem: FMElems.Elem; destDev: FMDevObj.Device); PROCEDURE (d: Device) MoveDir*(destParent, srcParent, elem: FMElems.FolderElem; srcDev:FMDevObj.Device); PROCEDURE (d: Device) MoveToTrash*(parent: FMElems.FolderElem; elem: FMElems.Elem); PROCEDURE (d: Device) NewDirectory*(parent: FMElems.FolderElem; name: ARRAY OF CHAR); PROCEDURE (d: Device) Open*(parent: FMElems.FolderElem; srcElem: FMElems.Elem); PROCEDURE (d: Device) Rename*(parent: FMElems.FolderElem; elem: FMElems.Elem; VAR name: ARRAY OF CHAR); PROCEDURE (d: Device) DeleteFiles*(root: FMDevObj.Node); PROCEDURE (d: Device) CopyMoveFiles*(destParent: FMElems.FolderElem; srcDev: FMDevObj.Device; srcRoot: FMDevObj.Node; copy: BOOLEAN); PROCEDURE NewDevObj(fullName, path: ARRAY OF CHAR; VAR folder: FMElems.FolderElem; VAR attributes: FMElems.Attributes; sortOrder, pattern: ARRAY OF CHAR; s: FTPSession; downloadsPath: ARRAY OF CHAR): Device; PROCEDURE Init; (*********** FTP ***********) (* The following procedures are for processing command arguments *) (* Since they operate on Readers, this procedures can also be *) (* applied to server responses. *) PROCEDURE SkipBlanks(VAR r: T.Reader; VAR ch: CHAR); PROCEDURE ReadArg(VAR r: T.Reader; VAR ch: CHAR; delimChars: ARRAY OF CHAR; VAR arg: ARRAY OF CHAR; inclBlanks: BOOLEAN); PROCEDURE GetArgsReader(VAR r: T.Reader; VAR ch: CHAR; VAR success: BOOLEAN); (* User Profile *) PROCEDURE GetProfile(VAR prof: Profile); (* Attributes, Sort order, ... *) (* Most of the following code is taken from FileManager.Mod, with minor changes *) PROCEDURE Change(t: FMFrames.Text; id: INTEGER; root: FMDevObj.Node; VAR name: ARRAY OF CHAR); PROCEDURE ExecuteCmd(id: INTEGER; param: ARRAY OF CHAR); PROCEDURE SwitchAttribute*; PROCEDURE Sort*; PROCEDURE View*; PROCEDURE Refresh*; PROCEDURE ToggleListMethod*; PROCEDURE ToggleLog*; (* Basic connection handling *) PROCEDURE ResolveAddress(host: ARRAY OF CHAR; VAR hostAddr: TCP.IpAdr; VAR res: INTEGER); PROCEDURE WriteHostAddr(hostAddr: TCP.IpAdr); PROCEDURE Open*; PROCEDURE Copy*; PROCEDURE CopyTo*; PROCEDURE NewFolder*; PROCEDURE Delete*; PROCEDURE SendCmd*; PROCEDURE SetFileType(type: INTEGER); PROCEDURE ASCII*; PROCEDURE Binary*; PROCEDURE Automatic*; PROCEDURE Status*; PROCEDURE Abort*; (* Initialization *) BEGIN Init(); T.OpenWriter(w); T.WriteString(w, "FTP-Client (GO, 19.12.96)"); T.WriteLn(w); T.Append(O.Log, w.buf) END FTP.