The Unsorted BBS Collection/thegreatunsorted.tar/thegreatunsorted/misc/remotelg.pas

Pascal/Delphi Source File | 2001-02-10 | 6KB | 259 lines

program TelenetHacker;

USES
     DOS, ASYNC12, CRT;

TYPE
     ModemStuff =
          RECORD
          ComPort,
          Stopbits,
          Databits,
          TimeToWait : byte;
          Parity     : char;
          Baudrate,
          ModemDelay : integer;
          HayesHangup,
          HayesReset,
          HayesInit1,
          HayesInit2,
          HayesDial  : string;
          end;
VAR
     SystemDate,
     SystemTime,
     CR,
     LF,
     CL,
     BS,
     SPACE,
     filename,
     AreaCode     : string;
     done         : boolean;
     ModemRec     : ModemStuff;

Procedure TimeDate;
const
     days : array[0 .. 6] of string[3] =
          ('Sun', 'Mon', 'Tue', 'Wed', 'Thu', 'Fri', 'Sat');
     months : array[1 .. 12] of string[3] =
          ('Jan', 'Feb', 'Mar', 'Apr', 'May', 'Jun', 'Jul', 'Aug', 'Sep', 'Oct', 'Nov', 'Dec');
var
     year,
     month,
     day,
     dayofweek  : word;
     xyear,
     xmonth,
     xday,
     xdayofweek : string;
     hour,
     minute,
     second,
     sec100     : word;
     xhour,
     xminute,
     xsecond,
     xsec100    : string;

begin
getdate(year, month, day, dayofweek);
str(year, xyear); xyear := copy(xyear, 3, 2);
str(month, xmonth);
str(day, xday);
str(dayofweek, xdayofweek);
SystemDate := days[dayofweek]+' '+xday+'-'+months[month]+'-'+xyear;

gettime(hour, minute, second, sec100);
str(hour, xhour);
str(minute, xminute);
str(second, xsecond);
str(sec100, xsec100);
if hour < 10 then xhour := '0'+xhour;
if minute < 10 then xminute := '0'+xminute;
if second < 10 then xsecond := '0'+xsecond;
SystemTime := xhour+':'+xminute+':'+xsecond;
end;


procedure InitComport;
begin
closecom(ModemRec.Comport);
if NOT comexist(ModemRec.Comport) then
     begin
     writeln('Comport does not exist');
     halt;
     end;
if NOT opencom(ModemRec.Comport, 2000, 2000) then
     begin
     writeln('Comport fails to open');
     halt;
     end;
ModemRec.Baudrate := 1200;
comparams(ModemRec.Comport,
          ModemRec.Baudrate,
          ModemRec.Databits,
          ModemRec.Parity,
          ModemRec.Stopbits);
if NOT ctsstat(ModemRec.Comport) then
     begin
     writeln('CTS not active.');
     end;
if NOT dsrstat(ModemRec.Comport) then
     begin
     writeln('DSR not active.');
     end;
softhandshake(ModemRec.Comport, true, ^Q, ^S);
end;

function ModemOK : boolean;
var
     ch : char;
     O_counter,
     K_counter : longint;
     st : string;
     forever : boolean;
begin
forever := false;
ModemOK := false;
O_counter := 0;
K_counter := 0;
st := '';
repeat
     if O_counter > 150000 then exit;
     inc(O_counter);
     ch := comreadch(ModemRec.Comport);
     if ch = 'O' then
          begin
          writeln;
          write('O');
          K_counter := 0;
          st := st + ch;
          repeat
               if K_counter > 150000 then exit;
               inc(K_counter);
               ch := comreadch(ModemRec.Comport);
               if ch = 'K' then
                    begin
                    writeln('K');
                    st := st + ch;
                    ModemOK := true;
                    clearcom(ModemRec.Comport, 'B');
                    exit;
                    end;
          until forever;
          end;
until forever;
end;

function ModemInitStringSent : boolean;
begin
comwritewithdelay(ModemRec.Comport, '++++++', ModemRec.ModemDelay);
ModemInitStringSent := false;
repeat
     ModemRec.ModemDelay := ModemRec.ModemDelay + 20;
     if ModemRec.ModemDelay > 500 then
          begin
          writeln('Modem NOT responding.');
          halt;
          end;
     comwritewithdelay(ModemRec.Comport, ModemRec.HayesReset + CR, ModemRec.ModemDelay);
until ModemOK;
delay(ModemRec.ModemDelay);

repeat
     ModemRec.ModemDelay := ModemRec.ModemDelay + 20;
     if ModemRec.ModemDelay > 500 then
          begin
          writeln('Modem NOT responding.');
          halt;
          end;
     comwritewithdelay(ModemRec.Comport, ModemRec.HayesInit1 + CR, ModemRec.ModemDelay);
until ModemOK;
delay(ModemRec.ModemDelay);

repeat
     ModemRec.ModemDelay := ModemRec.ModemDelay + 20;
     if ModemRec.ModemDelay > 500 then
          begin
          writeln('Modem NOT responding.');
          halt;
          end;
     comwritewithdelay(ModemRec.Comport, ModemRec.HayesInit2 + CR, ModemRec.ModemDelay);
until ModemOK;
delay(ModemRec.ModemDelay);
ModemInitStringSent := True;
end;


function AllCaps(st : string) : string;
var
     x : integer;
begin
for x := 1 to length(st) do
     begin
     st[x] := upcase(st[x]);
     end;
AllCaps := st;
end;

function DialRT : boolean;
var
     timeout : integer;
begin
DialRT := false;
timeout := 0;
comwritewithdelay(ModemRec.Comport, ModemRec.HayesDial+'xxxxxxx'+CR, ModemRec.ModemDelay);
repeat
     delay(5000);
     inc(timeout);
     if timeout > ModemRec.TimeToWait then exit;  (* the dial failed... *)
until DCDstat(ModemRec.Comport);
DialRT := true;
end;

Procedure Send(filename:string);
var
     filevar:text;
     oneline:string;
begin
assign(filevar, filename);
reset(filevar);
repeat
     ReadLn(filevar, oneline);
     ComWriteln(ModemRec.Comport, oneline); WriteLn(Oneline);
     delay(2000);
until eof(filevar);
delay(5000);
end;

begin
ModemRec.ComPort      := 2;
ModemRec.Stopbits     := 1;
ModemRec.Databits     := 8;
ModemRec.TimeToWait   := 6;
ModemRec.Parity       := 'N';
ModemRec.Baudrate     := 1200;
ModemRec.ModemDelay   := 200;
ModemRec.HayesHangup  := 'ATH';
ModemRec.HayesReset   := 'ATZ';
ModemRec.HayesInit1   := 'ATM1';
ModemRec.HayesInit2   := 'ATM1';
ModemRec.HayesDial    := 'ATDT';

CR           := #13;
LF           := #10;
CL           := CR+LF;
BS           := #8;
SPACE        := #32;

done         := false;
TimeDate;
InitComport;
Repeat Until ModemInitStringSent;
if DialRT then
     begin
     Send('c:\waffle\words\netinfo');
     CloseCom(ModemRec.Comport);
     end
end.