{ PICS2K.INC - Pascal Integrated Communications System Overlays} { 6/10/87 Version 1.6 Copyright 1987 by Les Archambault} overlay procedure login; var continue,abort: boolean; key: StrName; procedure clear_sysm_heap; var thisS: SysmPtr; begin while SysmBase <> nil do begin thisS := SysmBase; SysmBase := SysmBase^.Next; dispose(thisS) end; end; procedure get_new_user(var continue: boolean); var i: integer; begin continue := FALSE; Writeln(USR); Writeln(USR, 'Name wurde nicht gefunden.'); list('A'); Writeln(USR); continue := ask('Bist Du neu in diesem System'); if continue then with user_rec do begin cy := prompt('Dein Wohnort (mit PLZ) ', len_cy, 'ESL'); Writeln(USR); Writeln(USR, 'Du bist also ',fn,' ',ln,' aus ',cy,'.'); Writeln(USR); continue := ask('Ist das so richtig'); if continue then begin Writeln(USR, 'Du kannst im Utilities-Menue Deine persoenlichen Daten eintragen.'); Writeln(USR, 'Nach Ueberpruefung Deiner Angaben wirst Du als Benutzer eingetragen.'); Writeln(USR); get_new_password; continue := online; if continue then begin used := 0; if fn = 'SYSOP' then access := 255 else access := uval_acc; limit := uval_time; if fn='SYSOP' then conf_flags:=254 else conf_flags := 0; ad := ''; ph := ''; comp := ''; columns := def_chars; lines := def_lines; for i := 0 to 5 do laston[i] := 0; time_today := 0; flags:=0; time_total := 0; lasthi := 0; upload := 0; download := 0; prot:='X'; key := pad(ln, len_ln) + pad(fn, len_fn); AddRec(DatF, user_loc, user_rec); AddKey(IdxF, user_loc, key); log(9, ''); list('I'); pause end end end end; procedure init_user; var user_counter : integer; str: StrTAD; begin temp_hi_lmr:=0; Seek(logr_file, 0); Read(logr_file, logr_rec); logr_rec.user := succ(logr_rec.user); {caller number} if logr_rec.user=maxint then logr_rec.user:=1; {reset } user_counter := logr_rec.user; Seek(logr_file, 0); Write(logr_file, logr_rec); if local_online then log(2, '#' + intstr(user_counter,5) + ', Local') else log(2, '#' + intstr(user_counter,5) + ', ' + intstr(rate, 3) + ' Bd'); GetTAD(login_t); if (login_t[3] <> user_rec.laston[3]) or (login_t[4] <> user_rec.laston[4]) or (login_t[5] <> user_rec.laston[5]) then user_rec.time_today := 0; if user_rec.access < 10 { Hang up on twit } then remote_online := FALSE else show_user_stats; end; procedure make_index; var i: integer; SysmThis, SysmLast: SysmPtr; begin i := 0; SysmBase := nil; Reset(sysm_file); Read(sysm_file, sysm_rec); while not EOF(sysm_file) do begin if sysm_rec[1] = ':' then begin new(SysmThis); if SysmBase = nil then SysmBase := SysmThis else SysmLast^.Next := SysmThis; SysmLast := SysmThis; SysmLast^.key := sysm_rec[2]; SysmLast^.loc := i; SysmLast^.Next := nil; end; read(sysm_file, sysm_rec); i := succ(i); end; end; begin { login } abort:=false; Writeln(USR, version); repeat until (not BRK) or (not online); if (not macro_in_progress) and (online) then begin close (sysm_file); Writeln(USR); Writeln(USR); ansi := ask('Moechtest Du ANSI-Grafik'); if ansi then assign(sysm_file, sysm_drv + sysm1_name + ext) else assign(sysm_file, sysm_drv + sysm_name + ext); clear_sysm_heap; make_index; end; if (not macro_in_progress) and (online) then list('W'); repeat if macro_in_progress then begin user_rec.fn:='SYSOP'; user_rec.ln:=''; end else get_name(user_rec.fn, user_rec.ln,'C'); timeout := sleepy_time; { increase input timeout } key := pad(user_rec.ln, len_ln) + pad(user_rec.fn, len_fn); FindKey(IdxF, user_loc, key); if OK then begin GetRec(DatF, user_loc, user_rec); if macro_in_progress then begin valid_pw:=true; mode:=sysop_mode; end else begin Get_old_password('Passwort ',valid_pw); if not valid_pw then list('P'); end; continue := TRUE; end else begin if diskfree(homdrv,homusr)>maxfree_logs then begin get_new_user(continue); if continue then valid_pw:=true; end else begin valid_pw:=false; writeln(usr); writeln(usr, 'Name nicht gefunden.'); writeln(usr, 'Momentan reicht der Speicher fuer neue Anrufer nicht aus.'); writeln(usr, ' Ruf bald wieder mal an.'); writeln(usr); delay(5000); continue:=false; remote_online:=false; mdhangup; abort:=true; end; end; until (not online) or continue or abort; in_use := valid_pw; connected := continue; if online and in_use then init_user; end; overlay procedure cold_start; var i,try,errcnt : integer; SysmThis, SysmLast: SysmPtr; sysm_text: text; t:tad_array; Procedure build_sysm; { Build SYSMSG.BB# file } var i:integer; goof,error:boolean; work:string[80]; begin goof:=false; errcnt:=0; {$I-} Close(sysm_file) {$I+}; { Shouldn't erase an open file } i := IOresult; { Ignore any errors } Rewrite(sysm_file); Assign(sysm_text, current_name + '.TXT'); {$I-} Reset(sysm_text) {$I+}; if IOresult = 0 then begin Write(' Lege an ', current_name, ext); while (not eof(sysm_text)) and (errcnt<50) do begin {$I-} readln(sysm_text,work); {$I+} error:=(ioresult<>0); if length(work)>80 then begin sysm_rec:=copy(work,1,80); writeln; writeln; writeln('Zeile zu lang, wird abgeschnitten.'); writeln; goof:=true; end else sysm_rec:=work; if not error then write(sysm_file,sysm_rec); if error then begin writeln; writeln; writeln('Fehler beim Lesen einer Textzeile. Kein CR,LF ? '); goof:=true; errcnt:=succ(errcnt); end; end; {while not eof text file} Close(sysm_text); Close(sysm_file); Reset(sysm_file); if goof or error then begin writeln; writeln(sysm_drv,sysm_name,'.TXT verursacht Probleme, ', 'Teile von SYSMSG.BB# wurden nicht komplett geschrieben.'); writeln; writeln(' Zeilen im Text-File sollten nicht laenger als 79 Zeichen sein'); writeln(' oder "high bits" (soft CRs) Deines Text-Editors enthalten.'); writeln; delay(10000); end; end {ioresult=0} else begin Writeln; Write('System Message Text File ', current_name,'.TXT nicht gefunden.'); end; Writeln; end; procedure Open_System_Message; begin Try := 0; {$I-} Reset (sysm_file) {$I+}; if IOresult <> 0 then begin Write('Kann ', current_name + ext, ' nicht oeffnen.'); Build_Sysm; try := succ(try); end; {$I-} read(sysm_file, sysm_rec) {$I+}; if IOresult <> 0 then begin OK := FALSE; if try = 0 then begin Write('Kann ', current_name + ext, ' nicht lesen.'); Build_Sysm; Seek(sysm_file,0); {$I-} Read(sysm_file, sysm_rec); {$I+} OK := (IOresult = 0); end; if not OK then begin Writeln; Writeln('Kann ', current_name + ext, ' nicht anlegen.'); Writeln('Weitermachen ist nicht moeglich!'); Halt; end; end; i := 0; end; begin {cold start} debug:=false; cold := TRUE; lps := (Mhz/4.0)*625.0; {adjust for machine speed} (* for i:=0 to 5 do global_date[i]:=0; auskommentiert fuer CPC.CLK - B.B. *) mult_cmds :=false; {no multiple commands} cmd_queue :=''; chat_ok := def_chat_ok; clock := true; {unless turned off} hour_count := 0.0; macro_in_progress := TRUE; gettad(t); macro_done := t[3]; val_acc := def_val_acc; uval_acc := def_uval_acc; val_time := def_val_time; uval_time := def_uval_time; chatstart := def_chatstart; chatend := def_chatend; unv_days := def_unv_days; val_days := def_val_days; unr_days := def_unr_days; rea_days := def_rea_days; max_tries := def_max_tries; restrict300 := def_restrict300; start_restrict300 := def_start_restrict300; end_restrict300 := def_end_restrict300; auto_macro := def_auto_macro; auto_macro_start := def_auto_macro_start; max_msg_lines := def_max_msg_lines; restrict_public := def_restrict_public; limit_lines :=def_limit_lines; up_down_ratio :=def_up_down_ratio; sleepy_time :=def_sleepy_time; maxfree_uplds :=def_maxfree_uplds; maxfree_logs :=def_maxfree_logs; maxfree_mslimit :=def_maxfree_mslimit; maxfree_lines :=def_maxfree_lines; maxfree_abs :=def_maxfree_abs; extra_time_sw :=def_extra_time; extra_time_start :=def_extra_time_start; extra_time_stop :=def_extra_time_stop; extra_time_val :=def_extra_time_val; time_adjust :=def_time_adjust; macro := Deflt_macro; audit_on := FALSE; delay_down := FALSE; in_library := FALSE; { Start in non-library mode } in_arc := FALSE; SysmBase := nil; { Initialize pointers} SectBase := nil; AreaBase := nil; MesgBase := nil; DirBase := nil; LibBase := nil; Artbase := nil; ArcBase := nil; UsrOutPtr := addr(putchar); { Initialize output driver } HomDrv := BDOS(getdrive); { Assume system files are } HomUsr := BDOS(getseluser, $FF); { in the startup area } AudDrv := Homdrv; { default setting} AudUsr := HomUsr; BDOS(ResDsk); { Reset disks} setsect(homdrv,homusr); { Return to proper drive, user} Assign(summ_file, summ_drv + summ_name + ext); Assign(mesg_file, mesg_drv + mesg_name + ext); Assign(logr_file, logr_drv + logr_name + ext); Assign(stat_file, stat_drv + stat_name + ext); Assign(nwin_file, nwin_drv + nwin_name + ext); current_name := sysm_drv + sysm_name; Assign(sysm_file, current_name + ext); Open_System_Message; Close(sysm_file); current_name := sysm_drv + sysm1_name; Assign(Sysm_File, current_name + ext); Open_System_Message; Read_Section_File; if auto_macro and (t[2]