{PICSKMS2.INC Pascal Integrated Communications System } { 5/25/87 vers 1.6 Copyright 1987 by Les Archambault } (* THIS SECTION FOR CP/M 2.x ONLY ... Overlay function diskfree(drive,user:integer): integer; type param = record spt: integer; bsh, blm, exm: byte; dsm, drm, al, cks, off: integer end; var allocptr, reserved, blocksize, disksize, i: integer; dpbptr: ^param; begin setsect(drive,user); allocptr := BDOSHL(getallocvec, 0); dpbptr := ptr(BDOSHL(getdiskparm, 0)); with dpbptr^ do begin reserved := 0; for i := 0 to 15 do reserved := reserved + (al shr i) and 1; disksize := succ(dsm) - reserved; for i := reserved to dsm do disksize := disksize - (((mem[allocptr + i shr 3] shl (i mod 8)) and $80) shr 7); blocksize := 1 shl (bsh - 3) end; setsect(homdrv,homusr); diskfree := disksize * blocksize end; ... END OF ORIGINAL CODE *) Overlay Function DiskFree(drive, user: integer): Integer; { This positively will work on CP/M 3.x and will surely fail on CP/M 2.x } Var BTemp : Array[0..2] of Byte; CurrentDrive : Integer; CurrentDMA : Integer; Begin SetSect(drive,user); BTemp[0] := SCB_Drv; BTemp[1] := 0; CurrentDrive := BDOS(SCB,Addr(BTemp)); BTemp[0] := SCB_DMA; BTemp[1] := 0; CurrentDMA := BDOSHL(SCB,Addr(BTemp)); Bdos(setdma,Addr(BTemp)); Bdos(DskSpc,CurrentDrive); SetSect(homdrv,homusr); DiskFree := ( BTemp[2] shl 13 ) or ( BTemp[1] shl 5 ) or ( BTemp[0] shr 3 ); BDOS(setdma,CurrentDMA); End; overlay procedure get_name(var fn: firstname; var ln: lastname;mode:char); { Get user name } var try,try_name,i:integer; tln:lastname; tfn:firstname; work:strstd; ch:char; test_names,found:boolean; namesfile:text; begin writeln(USR); try:=0; try_name:=0; test_names:=true; found:=false; if mode='C' then begin Assign(namesfile,'E:BADNAMES.LST'); {$I-} Reset(namesfile); {$I+} if ioresult<>0 then test_names:=false; {file doesn't exist} end else test_names:=false; Repeat repeat fn := trim(prompt('Vorname ',80, 'ESNU')); try:=succ(try); until (not online) or (fn <> '') or (try>max_tries); if try>max_tries then begin remote_online:=false; mdhangup; end; if fn = 'SYSOP' then ln := '' else begin try:=0; repeat ln := trim(prompt('Zuname ', len_ln, 'ESNU')); try:=succ(try); until (not online) or (ln <> '') or (try>max_tries); if try>max_tries then begin remote_online:=false; mdhangup; end; end; if (try0) or (pos(tln,work)<>0) then found:=true; end; if found then begin Writeln(usr,'Dieser Name ist reserviert...nochmal versuchen...'); try_name:=succ(try_name); found:=false; end else test_names:=false; end; if try_name>max_tries then begin remote_online:=false; mdhangup; end; until (not online) or (try>max_tries) or (try_name>max_tries) or (not test_names); end; overlay procedure change_user_params_A(num:integer; var temp_user_rec:user_list); var temp,i: integer; str: StrStd; procedure set_bit(var target; bit_num:integer); var subject:integer absolute target; mask:integer; begin mask:=1 shl bit_num; subject:=subject or mask; end; procedure clear_bit(var target;bit_num:integer); var subject:integer absolute target; mask:integer; begin mask:=not(1 shl bit_num); subject:=subject and mask; end; begin {change user params A} with temp_user_rec do begin Case Num of 1 : begin str:=prompt('Adresse ', len_ad, 'EL'); if str <> '' then ad := str; end; 2 : begin str:=prompt('Wohnort ', len_cy, 'ESL'); if str <> '' then cy:=str; end; 3 : begin str:=prompt('Telefon-Nummer ', len_ph, 'EL'); if str <> '' then ph:=str; end; 4 : begin str:=prompt('Passwort ', len_pw, 'ESL'); if str <> '' then pw:=str; end; 5 : begin str:=prompt('Computer ', len_comp, 'EL'); if str <> '' then comp:=str; end; 6 : begin str:=prompt('Access Level ', 3, 'EL'); if str <> '' then begin temp := strint(str); if (temp <= user_rec.access) or (not remote_copy) then access := temp end; end; 7 : begin str:=prompt('Zeit-Limit (Min.) ', 3, 'EL'); if str <> '' then limit := strint(str); end; 8 : begin str:=prompt('Nullen ', 1, 'EL'); if str <> '' then nulls := strint(str); end; 9 : begin str:=prompt('Schreibweise (Upper/Lower) ', 1, 'ESL'); if str <> '' then shift_lock := (str = 'U'); end; 10 : begin str:=prompt('Prompt-Bell (J/N) ', 1, 'ESL'); if str <> '' then noisy := (str = 'N'); end; 11 : begin str:=prompt('Konferenzen 1-7 [Eingabe aufsteigend #s: 0=keine] ', 7, 'ESL'); if str <> '' then begin clear_bit(conf_flags,0); {don't use this bit} for i:=1 to 7 do if pos(chr(i+48),str)>0 then set_bit(conf_flags,i) else clear_bit(conf_flags,i); if str='0' then conf_flags:=0; end; end; 12 : begin str:=prompt('Transferprotokoll ',1,'ESL'); if str in ['X','K','B'] then prot := str[1]; end; 13 : begin str:=prompt('Bildschirmbreite (Spalten) ', 2, 'ESL'); if str <> '' then columns := strint(str); end; end; {case} end; end; overlay procedure change_user_params_B(num:integer; var temp_user_rec:user_list); var temp,i: integer; str: StrStd; procedure set_bit(var target; bit_num:integer); var subject:integer absolute target; mask:integer; begin mask:=1 shl bit_num; subject:=subject or mask; end; procedure clear_bit(var target;bit_num:integer); var subject:integer absolute target; mask:integer; begin mask:=not(1 shl bit_num); subject:=subject and mask; end; begin {change user params B} with temp_user_rec do begin Case Num of 14 : begin str:=prompt('Zeilen pro Seite ', 2, 'ESL'); if str <> '' then lines := strint(str); end; 15 : begin str:=prompt('Online-Zeit heute ', 5, 'EL'); if str <> '' then time_today := strint(str); end; 16 : begin str:=prompt('Online-Zeit total ', 5, 'EL'); if str <> '' then time_total := strint(str); end; 17 : begin str:=prompt('Zuletzt gelesener Brief ', 5, 'EL'); if str <> '' then lasthi := strint(str); end; 18 : begin str:=prompt('Uploads ', 5, 'EL'); if str <> '' then upload := strint(str); end; 19 : begin str:=prompt('Downloads ', 5, 'EL'); if str <> '' then download := strint(str) end; 20 : if test_bit(flags,1) then clear_bit(flags,1) else set_bit(flags,1); 21 : if test_bit(flags,2) then clear_bit(flags,2) else set_bit(flags,2); 22 : if test_bit(flags,3) then clear_bit(flags,3) else set_bit(flags,3); 23 : if test_bit(flags,4) then clear_bit(flags,4) else set_bit(flags,4); 24 : if test_bit(flags,5) then clear_bit(flags,5) else set_bit(flags,5); end; {case} end; end; {End Picskms2.inc}