PAGE 59, 132 TITLE MSFILE -- Module to handle file I/O ; Update 20 Jan 86 IF1 %OUT >> Starting pass 1 ELSE %OUT >> Starting pass 2 ENDIF PUBLIC bufpnt, DTA, fcb, cpfcb, chrcnt, fixfcb, init, init1, gofil PUBLIC outbuf, ptchr, gtchr, gtnfil, getfil, filbuf, encode, decode PUBLIC nulref, nulr, decbuf, errpack, rptq, origr, rptct, rptval PUBLIC clrfln, cxmsg, biterr, intmsg, Clear_percent_message PUBLIC rppos, sppos, PerPr, KbPr, EOT_bells PUBLIC kbpos, perpos, prtscr, Close_transfer_screen, AbFil PUBLIC Say_aborted, Show_error, Show_warning, Show_status PUBLIC Show_retries, Show_packets, Do_CXZ_mode_line PUBLIC OFilSz, TFilSz, Write_to_standard_output INCLUDE MsDefs.H rptmin EQU 3 ; At least 3 of same char in a row ; equates for screen positioning scrfln EQU 0316H ; Place for file name scrkb EQU 0416H ; Place for Kbytes transferred scrper EQU 0516H ; Place for percent transferred Start_of_percent_line EQU 0500h ; Start of percent transferred line scrst EQU 0616H ; Place for status scrnp EQU 0816H ; Place for number of packets scrnrt EQU 0916H ; Place for number of retries screrr EQU 0A16H ; Place for error msgs ScrWrn EQU 0B16H ; Where warnings are displayed scrsp EQU 0C00H ; Place for send packet scrrp EQU 0E00H ; Place for receive packet DataS SEGMENT PUBLIC 'DataS' extrn data:byte, flags:byte, trans:byte, pack:byte, hierr:byte EVEN temp1 DW ? ; Temporary storage temp2 DW ? chrcnt DW ? ; Number of chars in the file buffer outpnt DW ? ; Position in packet bufpnt DW ? ; Position in file buffer fdtpnt DW ? ; Pointer to within our file fcbptr DW ? ; Position in FCB cbfptr DW ? ; Position in character buffer filsiz DW 0 ; Double word for filesize (in bytes.) DW 0 ofilsz DW 0 ; Original file size percent adjusted (/100) tfilsz DW 0 ; Bytes transferred DW 0 oldper DW 1234 ; old percentage oldper2 DW 101 ; old percentage 2 (after computation) oldkbt DW ? ; old KB transferred bufhex DW 80H File_handle DW 0 ; Handle of file we are currently working with File_buffer_ptr DW 0 ; Pointer into file buffer File_buffer_count DW 0 ; Number of bytes stored in buffer ; File_buffer DB 2048 DUP (?) ; Big buffer for reading and writing files DTA DB 128 DUP (?) ; Used in wild-card searches Ender DB Bell, Bell, '$' ; For end-of-transmission, if enabled outlin DB cr,lf,cr,lf db cr,lf,' File name:' db cr,lf,' KBytes transferred: 0' db cr,lf db cr,lf db cr,lf db cr,lf,' Number of packets: 0' db cr,lf,' Number of retries: 0' db cr,lf,' Last error: None' db cr,lf,' Last warning: None' db '$' NRD_Msg1 DB 'Please insert a formatted disk in the disk drive, or$' NRD_Msg2 DB 'type control-C to ABORT. Press any key when ready.$' WRP_Msg1 DB 'Please remove the write-protect tab from the diskette,$' WRP_Msg2 DB 'or type control-C to ABORT. Press any key when ready.$' NRD_Addr1 EQU (19*256)+5 ; Locations for messages NRD_Addr2 EQU (20*256)+5 Abort_msg DB 'Aborted with ^C$' ermes4 DB 'Unable to rename file$' ermes4a DB 'Remote ' Program_name DB ': Unable to rename file$' erms10 DB 'Remote ' Program_name DB ': Unable to receive data$' erms11 DB 'Disk full$' erms11a DB 'Remote ' Program_name DB ': Disk full$' ErMs12 DB 'Unable to create file$' ErMs12a DB 'Remote ' Program_name DB ': Unable to create file$' erms17 DB 'Record length exceeds size of buffer$' infms5 DB 'Renaming file to $' InfMs7 DB 'File interrupt$' InfMs8 DB 'File group interrupt$' hibit DB 'Non-ASCII character in file$' Q_mark DB '? $' Percent_sign DB '% $' crlf DB cr,lf,'$' printer DB 0,'LPT1 ' spchar2 DB 24H,26H,23H,40H,21H,25H,27H,28H,29H,2DH DB 7BH,7DH,5FH,5EH,7EH,60H spc2len EQU $-spchar2 Tmp DB ' ','$' ; One char string next DB 0FFH ; No next character just yet rptval DB 0 ; Repeated character rptct DB 1 ; Number of times it's repeated rptq DB drpt ; Repeat prefix origr DB drpt ; Original repeat prefix wrpmsg DB ? ; non-zero if we wrote percent message permsg DB cr,' Percent transferred:$' cxzhlp DB ' Ret=Retry ^X=Cancel file ^Z=Cancel group' DB ' ^E=Protocol abort ^C=Full abort$' asmsg DB ' as ' asmln EQU $-asmsg filbuf DB 60H DUP(?) ; Character buffer fcb DB fcbsiz DUP(?) ; Use as our FCB cpfcb DB fcbsiz DUP(?) ; Save FCB in case of "*". [7] decbuf DB dmasiz DUP(?) ; For decoding incoming data DataS ENDS Code SEGMENT PUBLIC EXTRN SPack:NEAR, CmBlnk:NEAR, Locate:NEAR, Nout:NEAR EXTRN PutMod:NEAR, PosCur:NEAR, ClearL:NEAR, FCBcpy:NEAR EXTRN ClrMod:NEAR, Beep:NEAR, Get_Error:NEAR ASSUME cs:Code, ds:DataS ; Display status of a file transfer Show_status PROC cmp Flags.RemFlg, 0 ; In remote mode? jz SST_0 ; No ret ; Quit quietly SST_0: push dx ; Save ptr to message mov dx, ScrSt ; Position for status messages call PosCur ; Go there call ClearL ; Clear out any existing message pop dx ; Get back message ; jmp Write_to_standard_output ; Use standard routine to do this Show_status ENDP Write_to_standard_output PROC mov di, dx ; Copy to di cld ; Forwards mov ax, ds ; Copy ds ... mov es, ax ; ... to es mov cx, 300 ; Scan lots of characters mov al, '$' ; Want to find dollar sign repne scasb ; Search for it mov bx, di ; Find length of string sub bx, dx ; Subtract ptr to start mov di, dx ; Copy to di again mov cx, 300 ; Scan lots of characters sub al, al ; Look for a zero this time repne scasb ; Search for it mov cx, di ; Copy ending ptr to cx sub cx, dx ; Subtract ptr to start cmp cx, bx ; Use whichever length is LESS jl WSO_1 ; Stick with cx (0 is closer than dollar sign) mov cx, bx ; Use the other value (dollar sign is closer) WSO_1: dec cx ; Drop by 1 for terminating value mov ah, WRITEF2 ; Code to write to a file handle mov bx, 1 ; Standard output int Dos ret Write_to_standard_output ENDP ; Display number of retries Show_retries PROC cmp Flags.RemFlg, 0 ; In remote mode? jz SRE_0 ; No ret ; Quit quietly SRE_0: mov dx, ScrNRt ; Position for number of retries call PosCur ; Go there mov ax, Pack.NumRtr ; Number of retries call Nout ; Write the number jmp ClearL ; Clear out rest of line Show_retries ENDP ; Display number of packets Show_packets PROC cmp Flags.RemFlg, 0 ; In remote mode? jz SPA_0 ; No ret ; Quit quietly SPA_0: mov dx, ScrNP ; Position for number of packets call PosCur ; Go there mov ax, Pack.NumPkt ; Number of packets jmp Nout ; Write the number Show_packets ENDP ; Say that file transfer has been aborted Say_aborted PROC mov dx, OFFSET Abort_msg ; The message ; jmp Show_error ; Use other routine to display it Say_aborted ENDP ; Display an error message on a file transfer screen Show_error PROC call Beep ; Make a noise first cmp Flags.RemFlg, 0 ; Are we in remote mode? je SHE_0 ; No push dx ; Save reg mov dx, OFFSET Q_mark ; "? " call Write_to_standard_output ; Output in binary mode pop dx jmp SHORT SHW_1 ; Join common code SHE_0: push dx ; Save ptr to message mov dx, ScrErr ; Position for error messages call PosCur ; Go there call ClearL ; Clear out any existing message pop dx ; Get back message jmp SHORT SHW_1 ; Use warning code, same thing Show_warning: cmp Flags.RemFlg, 0 ; Are we in remote mode? je SHW_0 ; No push dx ; Save reg mov dx, OFFSET Percent_sign ; "% " call Write_to_standard_output ; Output in binary mode pop dx jmp SHORT SHW_1 ; Join common code SHW_0: push dx ; Save ptr to message mov dx, ScrWrn ; Position for warning messages call PosCur ; Go there call ClearL ; Clear out any existing message pop dx ; Get back message SHW_1: call Write_to_standard_output ; Output in binary mode cmp Flags.RemFlg, 0 ; Are we in remote mode? je SHW_2 ; No mov dx, OFFSET CrLf ; Ptr to CrLf call Write_to_standard_output ; Output in binary mode SHW_2: stc ; Force carry on in case it matters to anyone ret ; Done here Show_error ENDP ; Reassure user that we acknowledge his ^X/^Z INTMSG PROC NEAR cmp flags.xflg, 0 ; Writing to screen? je INT_1 ; No, ok to show this warning ret ; Do nothing INT_1: mov dx, OFFSET InfMs7 ; File interrupted? cmp flags.cxzflg, 'X' je INT_2 ; Yes mov dx, OFFSET InfMs8 ; File group interrupted INT_2: jmp Show_warning ; Put it on screen INTMSG ENDP ; Print err message that found a non-standard-Ascii char in the file BITERR PROC NEAR push bx mov dx, OFFSET hibit ; Message about non-ASCII chars call Show_warning ; Display it pop bx ret BITERR ENDP ; Clear out message about interrupted file CXMSG PROC NEAR cmp flags.xflg,0 ; Writing to screen? jne cxm0 ; Yes. Don't do anything mov dx, ScrWrn call poscur call clearl cxm0: ret CXMSG ENDP ; Clear out the old filename on the screen CLRFLN PROC mov dx,scrfln call poscur jmp clearl ; Clear to end of line. [19a] CLRFLN ENDP ; some random screen positioning functions kbpos: mov dx,scrkb ; KBytes transferred call poscur jmp clearl perpos: mov dx,scrper ; Percent transferred call poscur jmp clearl sppos: mov dx,scrsp ; Send packet location jmp poscur rppos: mov dx,scrrp ; Receive packet location jmp poscur ; Initialize buffers and clear line INIT PROC call Make_console_binary ; Set "console" into binary mode so ; "^C" isn't a problem cmp Flags.RemFlg, 0 ; Remote mode? jne Init1 ; Yes, no printing call cmblnk call locate mov ah,prstr ; Put statistics headers on the screen mov dx,offset outlin int dos call Do_CXZ_mode_line ; Use common code to do this mov wrpmsg,0 ; haven't printed the messsage yet ; jmp init1 Init1: mov chrcnt, dmasiz ; Number of chars left mov bufpnt, OFFSET DTA ; Addr for beginning mov hierr, 0 ret INIT ENDP Do_CXZ_mode_line PROC cmp Flags.RemFlg, 0 ; In remote mode? jz DCM_0 ; No ret ; Quit quietly DCM_0: mov dx, OFFSET CXZHlp jmp PutMod ; Write mode line Do_CXZ_mode_line ENDP ; Common routine to close out any file transfer screen -- ; erase the mode line and position the cursor in the lower ; left corner of the screen Close_transfer_screen PROC call Make_console_ASCII ; Set console back to ASCII mode cmp Flags.RemFlg, 0 ; In remote mode? jz CTS_0 ; No ret ; Quit quietly CTS_0: call ClrMod ; Erase the mode line mov dx, 1600h ; Line above lower left corner jmp PosCur ; Go there Close_transfer_screen ENDP ; Switch console into and out of binary mode Make_console_binary PROC mov ax, 4400h ; IOCTL function 0, get device info mov bx, 1 ; Standard output int Dos ; Get current info or dl, 20h ; Turn on the binary bit sub dh, dh ; Clear high half mov ax, 4401h ; IOCTL function 1, set device info int Dos ; Set it up ret Make_console_binary ENDP Make_console_ASCII PROC mov ax, 4400h ; IOCTL function 0, get device info mov bx, 1 ; Standard output int Dos ; Get current info and dl, NOT 20h ; Turn on the binary bit sub dh, dh ; Clear high half mov ax, 4401h ; IOCTL function 1, set device info int Dos ; Set it up ret Make_console_ASCII ENDP ; Output the chars in a packet ; Called with AX = size of the data, BX = address of source FILEIO PROC ptchr: mov cx,ax lea ax,outbuf ; Where to put data when buffer gets full ; jmp decode ; CX = Size of data, BX = Address of data, AX = Routine to call to ; dump data decode: push si push di push es push dx push ax mov ax,ds mov es,ax pop ax mov si,bx ; Source of data mov bx,ax ; Coroutine to call mov di,bufpnt ; Destination of data mov dh,0 ; assume no quote char cmp trans.ebquot,'N' ; no quoting? je decod1 ; yes, keep going cmp trans.ebquot,'Y' ; or not doing it? je decod1 ; yes, keep going mov dh,trans.ebquot ; otherwise use quote char decod1: mov rptct,0 ; Reset mov rptval,0 ; Ditto dec cx jge dcod11 ; More data jmp decod6 ; Else, we're through dcod11: dec chrcnt ; Decrement number of chars in dta jns decod2 ; Continue if space left push cx push dx push bx call bx ; Output it if full jmp SHORT decod5 ; Error return if disk is full nop pop bx pop dx pop cx mov di,bufpnt decod2: cmp rptct,0 ; Doing a repeat? je dcod20 ; No, so go get a character mov ah,0 mov al,rptval ; Get the character we're repeating jmp decod4 ; And write it out to the file dcod20: lodsb ; Pick up a char cmp rptq,0 ; Doing repeat quoting? je dcod21 ; Nope, skip this part cmp al,rptq ; Did we pick up the repeat quote char? jne dcod21 ; No, continue processing it lodsb ; Get the size dec cx ; Modify buffer count sub al,20H ; Was made printable mov rptct,al ; Remember how many repetitions lodsb ; Get the char to repeat dec cx ; Modify buffer count dcod21: mov ah,00H ; Assume no 8-bit quote char. [21b start] cmp al,dh ; This the 8-bit quot char? jne decod3 lodsb ; Get the real character dec cx ; Decrement # chars in packet mov ah,80H ; Turn on 8-bit quot char flag. [21b end] decod3: cmp al,trans.squote ; Is it the quote char? [21b] [21c] jne decod4 ; If not proceed lodsb ; Get the quoted character dec cx ; Decrement # of chars in packet or ah,al ; save parity (combine with prefix) and ah,80h ; only parity and al,7FH ; Turn off the parity bit cmp al,trans.squote ; Is it the quote char? [21c] je decod4 ; If so just go write it out cmp al,dh ; This the 8-bit quot char? je decod4 ; If so, just go write it out cmp al,rptq ; Is is the repeat quote character? je decod4 ; If so, just write it out add al,40H ; Make it a control char again and al,7FH ; Modulo 128 decod4: or al,ah ; or in parity stosb ; store the character dec rptct ; Repeat counter cmp rptct,0 ; Write out char again? jg dcod41 jmp decod1 ; No, get next char dcod41: mov rptval,al ; Save the char jmp dcod11 ; and loop to next char decod5: pop bx pop dx ; dx is pushed twice (really) pop cx pop dx pop es pop di pop si ret decod6: mov bufpnt,di pop dx pop es pop di pop si jmp rskp ; Return successfully if done ; output the buffer, reset bufpnt and chrcnt outbuf: cmp flags.xflg,1 ; Writing to screen? [21c] je outbf2 ; Yes, handle specially. [21c] push bx mov ah,writef ; The write code mov dx,offset fcb int dos ; Write the record pop bx cmp al,0 ; Successful jz outbf1 push ax ; Remember the return code. [20d] call abfil ; Fix things up before aborting. [20d] pop ax ; Retrive return code. [20d] cmp al,01 je outbf0 mov dx, OFFSET erms17 ; Record length exceeds dta call Show_error mov bx, OFFSET erms10 ; Text of message to send jmp errpack ; Send an error packet, ret from there outbf0: mov dx, OFFSET erms11 ; Disk full error call Show_error mov bx, OFFSET erms11a ; Text of message to send jmp errpack ; Send an error packet outbf1: add tfilsz+2,80H ; Say 128 more characters received adc tfilsz,0 call kbpr ; Print the kilobytes received call perpr ; Print the percent ('?' for now) outb11: mov bufpnt,offset DTA ; Addr for beginning mov chrcnt,dmasiz-1 ; Buffer size jmp rskp outbf2: mov cx,dmasiz-1 ; Number of chars to write. [21c] sub cx,chrcnt ; minus # of unused in buffer mov di,offset DTA ; Where they are. [21c] call prtscr ; Output buffer to screen. [21c] jmp outb11 ; Reset counter & pointer. [21c] ; Tidy up before aborting. [20d] ABFIL PROC mov ah,closf ; Close the file mov dx,offset fcb int dos cmp flags.abfflg,1 ; Delete what got across or keep it? jne abfil0 ; Nope, keep it mov ah,delf ; Delete it mov dx,offset fcb int dos abfil0: ret ABFIL ENDP ; General routine for sending an error packet. Register BX should ; point to the text of the message being sent in the packet. [20f] ERRPACK PROC mov di,offset data ; Where to put the message mov al,0 errp1: mov ah,[bx] cmp ah,'$' ; At end of message? je errp2 inc al ; Remember number of chars in msg mov [di],ah inc bx inc di jmp errp1 errp2: mov ah,0 mov pack.argbk1,ax mov ah,'E' ; And send an error packet call spack ret ; Return if succeed or fail nop nop ret ERRPACK ENDP ; Get the chars from the file gtchr: cmp flags.filflg,0 ; Is there anything in the DMA? jz gtchr0 ; Yup, proceed mov ah,rptq mov origr,ah ; Save repeat prefix here mov rptct,1 ; Number of times char is repeated mov rptval,0 ; Value of repeated char call inbuf jmp gtchr1 ; No more chars, go return EOF nop ; Make three bytes long gtchr0: lea bx,inbuf jmp encode gtchr1: mov ax,0ffffh ret ; encode - writes data portion of kermit packet into filbuf ; expects BX to contain the address of a routine to refill the buffer, ; chrcnt to be the # of chars in the buffer, trans.maxdat to contain ; the maximum size of the data packet, bufpnt to contain a pointer to ; the source of the characters ; Returns: AX/ the number of characters actually written to the buffer encode: mov cl,trans.maxdat ; Maximum packet size. [21b] mov ch,0 mov di,offset filbuf ; Where to put the data mov si,bufpnt ; pointer into source buffer mov dl,trans.rquote ; send quote char mov dh,0 ; assume no 8-bit quoting cmp trans.ebquot,'N' ; not doing 8-bit quoting je encod1 cmp trans.ebquot,'Y' ; or can but won't? je encod1 mov dh,0ffh ; remember we have to do it encod1: dec cx ; Decrement output buffer counter jge encod2 ; Go on if there is more than one left sub di,offset filbuf mov ax,di mov bufpnt,si ; update pointer into DMA jmp rskp encod2: dec chrcnt ; any data in buffer? jge encod3 ; yes, skip over buffer refill call bx ; Get another buffer full jmp encod8 mov si,bufpnt ; update position in DMA cmp chrcnt,0 ; no characters returned? jne encod3 ; Got some, keep going jmp encod8 ; none, assume eof encod3: lodsb cmp rptq,0 ; Are we doing repeat prefixing? je encd3x ; Nope, skip next part cmp chrcnt,0 ; Are we on the last character? jle encd31 ; Yes, so there's no next character cmp rptct,94 ; Max number that we can put in a byte je encd31 ; Then that's it mov ah,[si] ; Get the next character cmp al,ah ; Is current char == next char? jne encd31 inc rptct ; Number of times char appears mov rptval,al ; Remember the character inc cx ; Repeats don't take up so much buffer space jmp encod1 ; Keep checking for more encd31: cmp rptct,1 ; Were previous characters repeats? je encd3x ; No, so just add this char cmp rptct,rptmin ; Are we within bounds for repeat prefixing? jge encd32 ; Yes, use repeat prefixing mov al,rptct mov ah,0 sub si,ax ; Not enough characters to warrant it mov rptval,0 ; Clear out this value inc cx ; Adjust output buffer pointer mov al,rptq mov origr,al ; Save original repeat prefix mov rptq,0 ; Pretend we're not doing the prefixing mov al,rptct mov ah,0 add chrcnt,ax ; Adjust input buffer pointer jmp encod1 ; Reprocess those characters encd32: push ax ; Do repeat prefixing - save data mov al,rptq ; Add repeat prefix char stosb dec cx ; Account for it in buffer size mov al,rptct ; Get the repeat count add al,20H ; Make it printable stosb ; Add to buffer dec cx pop ax ; Get back the actual character mov rptct,1 ; Reset repeat count mov rptval,0 ; And this %OUT >> About half way through source file encd3x: cmp dh,0 ; are we doing 8-bit quoting? je encod4 ; no, forget this test al,80h ; parity on? je encod4 ; no, don't bother with this and al,7fh ; turn off parity push ax ; save original char for a bit dec cx ; decrement # of chars left mov al,trans.ebquot ; get quote char stosb ; save in buffer pop ax ; restore character encod4: mov ah,al ; save character and ah,80h ; only parity and al,7fh ; turn off parity in character cmp al,' ' ; Compare to a space jl encod5 ; If less then its a control char cmp al,del ; Is the char a delete? jz encod5 ; Go quote it cmp al,dl ; Is it the quote char? je encod6 ; Yes - go add it. [21b start] cmp dh,0 ; are we doing 8-bit quoting? je encd41 ; no, don't translate it cmp al,trans.ebquot ; Is it the 8-bit quote char? je encod6 ; Yes, just output with quote encd41: cmp origr,0 ; Doing repeat prefixing? je encod7 ; No, don't check for quote char cmp al,origr ; Is this the repeat quote character je encod6 ; Yes, then quote it jmp short encod7 ; else don't quote it encod5: add al,40h ; control char, uncontrollify and al,7fh encod6: push ax ; save the char dec cx mov al,dl stosb pop ax encod7: or al,ah ; put parity back stosb cmp rptct,1 ; One occurence of this char? jne encd7x mov al,origr mov rptq,al ; Restore repeat quote char jmp encod1 ; Yes, so loop around for some more encd7x: dec rptct ; Add another entry of this char jmp encod1 ; With quoting and all encod8: sub di,offset filbuf or di,di je encod9 ; Nope mov ax,di jmp rskp encod9: mov ax,0FFFFH ; Get a minus one ret inbuf: mov ah,flags.eoflag ; Have we reached the end? cmp ah,0 jz inbuf0 ret ; Return if set inbuf0: push si push di push dx push bx push cx mov bx,offset DTA ; Set the r/w buffer pointer mov bufpnt,bx mov ah,readf ; Read a record mov dx,offset fcb int dos mov cx,filsiz cmp cx,0 ; Check for 128 chars or less left jne inbuf1 ; Still have data left mov ax,ds mov es,ax mov si,offset filsiz+2 mov di,offset bufhex cmps filsiz+2,es:bufhex ja inbuf1 ; More than 128 chars mov flags.eoflag,0FFH ; Set End-of-file mov cx,filsiz+2 cmp flags.filflg,0 ; Ever used DMA? [25] jnz inbf01 dec cx ; Account for DEC in caller routine inbf01: mov chrcnt,cx ; Return proper number of chars mov flags.filflg,0 ; Buffer not empty pop cx pop bx pop dx pop di pop si jmp rskp inbuf1: sub filsiz+2,80H ; Sent another 128 chars sbb filsiz,0 ; Account for the doubleword add tfilsz+2,80H ; Book keeping for the same adc tfilsz,0 push ax call kbpr ; Print the kilobytes sent call perpr ; Print the percent sent pop ax mov al,80H ; Use as counter for number of chars read pop cx pop bx pop dx pop di pop si cmp flags.filflg,0 ; Ever used DMA? jnz inbf21 ; Nope, then don't change count dec al ; Fix boundary error inbf21: mov ah,0 ; Zero the flag (buffer not empty) mov chrcnt,ax ; Number of chars read from file mov flags.filflg,0 ; Buffer not empty jmp rskp nulref: mov chrcnt,0 ; No data to return jmp rskp nulr: ret ; Print the number of Kilobytes transferred kbpr: cmp flags.remflg,0 ; remote mode? jne kbpr1 ; yes, no printing mov ax,tfilsz+2 and ax,not (1111111111B) ; exclude low-order ten bits or ax,tfilsz ; get size words cmp ax,oldkbt ; is it the same? je kbpr1 ; yes, no printing mov oldkbt,ax mov ax,tfilsz+2 ; Get low order word mov cl, 10 ; Set up CL for shift count shr ax,cl ; Divide by 1024 mov bx,tfilsz ; Get high order word mov cl, 6 ; Set up CL for shift count shl bx,cl ; Move over to OR into AX or ax,bx push ax call kbpos ; Postion the cursor pop ax call nout ; Print the number of KBytes transferred kbpr1: ret ; Print the percent transferred PerPr: cmp Flags.RemFlg, 0 ; Remote mode? jne PPR_3 ; Yes, no printing cmp OFilSz, 0 ; Don't divide by zero je PPR_3 ; If not proceed mov ax, tfilsz ; Build silly hash value or ax, tfilsz+2 cmp ax, oldper ; Same as it was before? je PPR_3 ; Yes, don't bother printing mov oldper, ax ; Remember for next time cmp wrpmsg, 0 ; Did we write the percentage message? jne PPR_1 ; Yes, skip this part call PerPos ; position cursor mov ah, PrStr mov dx, OFFSET PerMsg int Dos ; Write out message mov WrPMsg, 1 ; Init flag so we don't do it again PPR_1: mov dx, TFilSz ; Get the high order word mov ax, TFilSz+2 ; Get the low order word div OFilSz ; Div by percent adjusted original file size cmp ax, 100 ; > 100% ? jle PPR_2 ; No, accept it mov ax, 100 ; Else just use 100 PPR_2: cmp ax, OldPer2 ; Same percent as last time? je PPR_3 ; Yes, don't flash cursor over same data mov OldPer2, ax ; Save for next time here push ax ; Save reg call PerPos ; Position the cursor pop ax call Nout mov ah, ConOut ; Print a character mov dl, '%' ; Load a percent sign int Dos PPR_3: ret Clear_percent_message: mov WrpMsg, 0 ; Forget this was ever here cmp Flags.RemFlg, 0 ; In remote mode? jne CPM_0 ; Yes, skip this cmp Flags.XFlg, 0 ; Writing to screen? jne CPM_0 ; Yes, skip this mov dx, Start_of_percent_line ; Where to go call PosCur ; Go there call ClearL ; Wipe the line CPM_0: ret ; Done here EOT_bells: cmp Flags.BelFlg, 0 ; Bell desired? je CEB_0 ; No mov ah, PrStr ; Code to type a string mov dx, OFFSET Ender ; ^G^G int Dos ; Type it CEB_0: ret ; Done here getfil: mov ah,0FFH mov flags.filflg,ah ; Nothing in the DMA sub ax, ax mov flags.eoflag,ah ; Not the end of file mov bx,offset fcb+0CH mov [bx],ax ; Zero the current block number mov bx,offset fcb+0EH mov [bx],ax ; Ditto for Lrecl mov bx,offset fcb+20H mov [bx],ah ; Zero the current record (of block) inc bx mov [bx],ax ; Same for record (of file) mov bx,offset fcb+23H mov [bx],ax mov ah,openf ; Open the file mov dx,offset fcb int dos mov dx,word ptr fcb+18 ; get file size (hi order word) mov filsiz,dx mov ax,word ptr fcb+16 ; lo order word mov filsiz+2,ax mov bx, 100 ; Get a 100 div bx ; Divide by it to convert for percentage mov ofilsz,ax mov tfilsz,0 ; Set bytes sent to zero mov tfilsz+2,0 mov oldkbt,-1 mov oldper,-1 cmp filsiz,0 ; Null file? jne getfl0 ; Nope cmp filsiz+2,0 ; Null file? jne getfl0 ; Nope mov flags.eoflag,0FFH ; Set EOF getfl0: jmp rskp gtnfil: cmp flags.cxzflg,'Z' ; Did we have a ^Z? [20b] je gtn5 ; If yes, we're done sending files. [20b] cmp flags.wldflg,0 ; Was there a "*"? [7 start] je gtn5 ; Nope mov bx,offset cpfcb ; Get FCB from last check for file. mov di,offset fcb ; Copy to FCB mov cl,37 ; Size of FCB call fcbcpy gtn2: mov ah,snext mov dx,offset fcb ; More files? int dos cmp al,0FFH je gtn5 mov bx,offset fcb mov di,offset cpfcb mov cl,37 call fcbcpy ; Copy from FCB mov di,offset fcb+1 ; Get name of next file to send mov bx,offset DTA+1 mov cl,11 call fcbcpy call getfil ; Initialize jmp r jmp rskp gtn5: mov flags.wldflg,0 ; Reset wild card flag ret ; [7 end] ; Get the file name (including host to micro translation) PUBLIC GoFlx, GoFil0, GoFil7, GoFil1 gofil: cmp flags.xflg,1 ; Remote command? [21c] jne goflx ; No.... [21c] jmp gofla ; Yes so skip this stuff. [21c] goflx: cmp flags.nmoflg,1 ; Overriding name from other side? [21a] jne gofil0 ; No - get the filename. [21a] ; Have to set up TEMP2 in case file must be renamed mov cx, 9 ; Start here cmp FCB + 8, ' ' ; Blank here? jne goflx_0 ; No mov cx, 7 cmp FCB + 7, ' ' ; Blank here? jne goflx_0 ; No dec cx cmp FCB + 6, ' ' ; Blank here? jne goflx_0 ; No dec cx cmp FCB + 5, ' ' ; Blank here? jne goflx_0 ; No dec cx cmp FCB + 4, ' ' ; Blank here? jne goflx_0 ; No dec cx cmp FCB + 3, ' ' ; Blank here? jne goflx_0 ; No dec cx cmp FCB + 2, ' ' ; Blank here? jne goflx_0 ; No goflx_0: mov temp2, cx ; Save for possible rename jmp gofil7 ; Ignore packet contents gofil0: mov bx,offset data ; Get the address of the file name. [21a] mov fdtpnt,bx ; Store the address mov bx,offset fcb+1 ; Address of the FCB mov fcbptr,bx ; Save it sub ax, ax mov temp1,ax ; Initialize the char count mov temp2,ax cmp flags.droflg,1 ; Default drive? [21a] je gofil1 ; No - don't blank out value in FCB. [21a] mov si,offset fcb mov [si],ah ; Set the drive to default to current gofil1: mov ch,' ' ; Moved the label. [21a] mov [bx],ch ; Blank the FCB inc bx inc ah cmp ah,0BH ; Twelve? jl gofil1 gofil2: mov bx,fdtpnt ; Get the NAME field mov ah,[bx] inc bx mov fdtpnt,bx cmp ah,'.' ; Separator? jne gofil3 mov bx,offset fcb+9 mov fcbptr,bx mov ax,temp1 mov temp2,ax mov temp1,9 jmp gofil6 gofil3: cmp ah,0 ; Trailing null? jz gofil7 ; Then we're done call verlet ; Verify that the char is legal mov bx,fcbptr mov [bx],ah inc bx mov fcbptr,bx mov ax,temp1 ; Get the char count inc ax mov temp1,ax cmp ax,8H ; Are we finished with this field? jl gofil2 gofil4: mov temp2,ax mov bx,fdtpnt mov ah,[bx] inc bx mov fdtpnt,bx cmp ah,0 jz gofil7 cmp ah,'.' ; Is this the terminator? jne gofil4 ; Go until we find it gofil6: mov bx,fdtpnt ; Get the TYPE field mov ah,[bx] inc bx mov fdtpnt,bx cmp ah,0 ; Trailing null? jz gofil7 ; Then we're done call verlet ; Verify that the char is legal mov bx,fcbptr mov [bx],ah inc bx mov fcbptr,bx inc temp1 ; Increment char count cmp temp1,0CH ; Are we finished with this field? jl gofil6 gofil7: cmp flags.remflg,0 ; remote mode? jne gofil7a ; yes, don't print it call prtfn ; Print the file name. [21a] gofil7a:cmp flags.destflg,0 ; Writing to the printer? jne gf7y push es mov ax,ds mov es,ax ; Set this up mov cx,11 mov si,offset printer mov di,offset fcb repne movsb ; Change name in FCB to be printer pop es jmp gofil9 gf7y: mov ah,flags.flwflg ; Is file warning on? cmp ah,0 jnz gf7x jmp gofil9 ; If not, just proceed gf7x: gf7xa: mov ah,openf ; See if the file exists mov dx,offset fcb int dos cmp al,0FFH ; Does it exist? jnz gf8x ; File exists, have to rename the incoming one call Check_for_Not_Ready ; Had an error, check for Drive Not Ready jnc gf7xa ; Drive Not Ready, user wants to try again jmp gofil9 ; Go create the file gf8x: mov dx, OFFSET InfMs5 ; Renaming file to ... call Show_warning mov ax,temp2 ; Get the number of chars in the file name cmp ax,0 jne gofil8 mov ax,temp1 mov temp2,ax gofil8: mov ch,0 mov cl,al mov al,0 ; Says if first field is full cmp cl,9H ; Is the first field full? jne gofl81 mov al,0FFH ; Set a flag saying so dec cl gofl81: mov bx,offset fcb ; Get the FCB add bx,cx ; Add in the character number mov ah,'&' mov [bx],ah ; Replace the char with an ampersand push ax push bx mov ah,openf ; See if the file exists mov dx,offset fcb int dos pop bx cmp al,0FFH ; Does it exist? pop ax jz gofl89 ; If not create it cmp al,0 ; Get the flag jz gofl83 dec cl ; Decrement the number of chars cmp cl,0 jz gofl88 ; If no more, die jmp gofl81 gofl83: inc cl ; Increment the number of chars cmp cl,9H ; Are we to the end? jl gofl81 ; If not try again ; else fail gofl88: mov dx, OFFSET ErMes4 ; Unable to rename file call Show_error mov bx, OFFSET ErMes4a ; Unable to rename file jmp errpack ; Send error packet before abort. [20f] gofl89: cmp Flags.RemFlg, 0 ; Remote mode? jne gofil9 ; Yes, don't have to print file name ; Type out the selected file name mov cx, 8 ; Maximum number of chars to type mov dx, OFFSET Fcb+1 ; Addr of the file name part call Type_without_trailing_blanks ; Type the first part mov Tmp, '.' ; Load a period mov ah, PrStr ; Code to type string mov dx, OFFSET Tmp ; The "string" int Dos ; Type the period mov cx, 3 ; Maximum number of chars to type mov dx, OFFSET Fcb+9 ; Addr of the file type part call Type_without_trailing_blanks ; Type the second part part gofil9: mov ah,delf ; Delete the file if it exists mov dx,offset fcb int dos sub ax, ax mov si,offset fcb+0CH mov [si],ax ; Zero current block mov si,offset fcb+0EH mov [si],ax ; Same for Lrecl mov si,offset fcb+20H mov [si],ah ; Zero the current record (within block) inc si mov [si],ax ; Zero record (within file) mov si,offset fcb+23H mov [si],ax mov ofilsz,0 ; File size unknown mov tfilsz,0 ; Set bytes received to zero mov tfilsz+2,0 mov oldkbt,-1 mov oldper,-1 mov ah,makef ; Now create it mov dx,offset fcb int dos cmp al,0FFH ; Is the disk full? je gf9x jmp rskp gf9x: call Check_for_Write_Protect ; We had an error, see if it was WP jc gf9x0 ; Not that type, or ABORT jmp gf7x ; Write Protect, user wants to try again, go ; all the way back to the Drive Ready check gf9x0: mov dx, OFFSET ErMs12 ; Unable to create file call Show_error mov bx, OFFSET ErMs12a ; Unable to create file jmp errpack ; Send an error packet gofla: cmp pack.argbk1,0 ; Any data in "X" packet? [21c start] je gofla1 ; Nothing to print mov ah,prstr mov dx,offset crlf int dos mov di,offset data ; Where data is mov cx,pack.argbk1 ; How much data we have call prtscr ; Print it on the screen gofla1: mov ah,prstr mov dx,offset crlf int dos jmp rskp ; And done. [21c end] FILEIO ENDP ; Routines to put friendly messages on the screen in special cases of ; understandable disk errors -- Drive Not Ready and Write Protect Error Tmsg MACRO Message mov dx, OFFSET Message mov ah, PrStr int Dos ENDM GoMsg MACRO Prefix,Number mov dx, NRD_Addr&Number call PosCur Tmsg Prefix&_Msg&Number ENDM PUBLIC Check_for_Not_Ready, Check_for_Write_Protect Check_for_Not_Ready PROC call Get_Error ; See what the error code was cmp ax, 2 ; Code for Drive Not Ready jne CCC_Abort ; Not what we got, give up GoMsg NRD,1 GoMsg NRD,2 jmp SHORT Check_common_code Check_for_Not_Ready ENDP Check_for_Write_Protect PROC call Get_Error ; See what the error code was cmp ax, 0 ; Code for Write Protect error jne CCC_Abort ; Not what we got, give up GoMsg WRP,1 GoMsg WRP,2 Check_common_code: call Beep ; Go make a noise mov ah, ConInQ ; Quiet console input int Dos ; Wait until user hits a key call Erase_error_message ; Get rid of the message cmp al, 3 ; Control-C? je CCC_Abort ; Yes, don't accept the file clc ; Clear carry for no error ret ; Return ready for retry CCC_Abort: stc ; Set carry for error ret ; Return error Check_for_Write_Protect ENDP PUBLIC Erase_error_message Erase_error_message PROC Clear_it MACRO Address mov dx, Address ;; Position call PosCur ;; Go there call ClearL ;; Clear out any existing message ENDM push ax ; Save reg Clear_it NRD_Addr1 ; Clear each line Clear_it NRD_Addr2 pop ax ; Restore reg ret Erase_error_message ENDP ; Call with ... ; cx/ maximum number of chars to type ; dx/ OFFSET within ds: of string to type PUBLIC Type_without_trailing_blanks Type_without_trailing_blanks PROC LP_1: mov bx, cx ; Copy to bx add bx, dx ; Add in OFFSET to string cmp BYTE PTR -1[bx], ' ' ; Is this a space? jne Got_one loop LP_1 ret ; Nothing but blanks, print nothing Got_one: cld ; Forwards mov ah, PrStr ; Doing this repeatedly mov si, dx ; Start at start of string mov dx, OFFSET Tmp ; Point at Tmp string LP_2: lodsb ; Pick up this byte mov Tmp, al ; Copy to Tmp int Dos ; Type the next byte loop LP_2 ; Go do another one ret ; Done here Type_without_trailing_blanks ENDP ; Passed char of incoming filename in AH. Verify that it is legal ; and if not change it to an "X" verlet: cmp ah,'0' jl ver2 ; See if it's a legal weird char cmp ah,'z'+1 jns ver2 cmp ah,'9' jle ver1 ; It's between 0-9 so it's OK cmp ah,'A' jl ver2 ; Coud be a weird char cmp ah,'Z' jle ver1 ; It's A-Z so it's OK cmp ah,'a' jl ver2 and ah,137O ; It's a-z, capitalize ver1: ret ver2: push es mov cx,ds mov es,cx ; Scan uses ES register mov di,offset spchar2 mov cx,spc2len mov al,ah ; Char is in al repnz scasb ; Search string for input char pop es mov ah,al ; Return it in AH cmp cx,0 ; Was it there? jnz ver1 ; Yes, return it mov ah,'X' ; If illegal, replace with "X" mov flags.nmoflg,1 ret ; Print incoming filename(s). [21a] PRTFN PROC call clrfln ; Position cursor & blank out the line mov di, OFFSET data ; Where to put the name cmp flags.nmoflg, 0 ; Is filename in packet? je prtfn1 ; no, keep going add di, pack.argbk1 ; bump by length of remote name mov si, OFFSET asmsg ; something to put after it mov cx, asmln ; length of it rep movsb ; add this to the buffer prtfn1: cmp flags.droflg,0 ; Drive specified? je prtfn2 ; No mov al, BYTE PTR FCB ; Pick up drive spec from FCB add al, '@' ; Make it readable stosb ; Add to buffer mov al, ":" ; And a colon stosb ; Add it also prtfn2: mov cx,8 ; At most 8 letters in file name mov si, OFFSET FCB + 1 ; This is the source now prtfn3: lodsb ; get a letter cmp al,' ' ; Done with name? je prtfn4 ; yes, continue stosb ; else store loop prtfn3 ; and loop thru rest prtfn4: mov si,offset fcb+9 ; Point to file type cmp byte ptr [si],' ' ; is there a type? je prtfn5 ; Nope so we're done mov al,'.' ; Add the dot stosb mov cx,3 ; At most 3 letters in file type rep movsb ; copy type (incl trailing spaces) prtfn5: mov ah, WRITEF2 ; Code to write to a file handle mov bx, 1 ; Standard output mov cx, di ; Copy ending ptr to cx sub cx, OFFSET Data ; Get length of data mov dx, OFFSET Data ; Ptr to data int Dos ; Type it to standard output ;tm mov flags.droflg,0 ; Reset flag once have the full name mov flags.nmoflg,0 ret PRTFN ENDP ; Print data onto the screen. ; ; Routine expects: DI = Start of buffer we are to print ; CX = Number of characters to print. [21c] PRTSCR PROC mov ah, WRITEF2 ; DOS 2.0 file handle write mov bx, 1 ; File handle 1 is standard output mov dx, di ; Copy buffer ptr to dx int Dos ; cx was already set up, just type the string ret ; That's it PRTSCR ENDP FIXFCB PROC push ax ; Don't forget this. [22] mov bx,offset fcb+18 mov di,offset filsiz mov ax,[bx] mov [di],ax mov bx,offset fcb+16 mov ax,[bx] mov 2[di],ax pop ax ; Get number of chars in last buffer full. [22] sub filsiz+2,ax ; Get real file size sbb filsiz,0 mov bx,offset fcb+18 mov di,offset filsiz mov ax,[di] mov [bx],ax mov bx,offset fcb+16 mov ax,2[di] mov [bx],ax ret FIXFCB ENDP ; Jumping to this location is like retskp. It assumes the instruction ; after the call is a jmp addr RSKP PROC NEAR pop bp add bp,3 push bp ; ret RSKP ENDP ; Jumping here is the same as a ret R PROC NEAR ret R ENDP Code ENDS END