home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / tcpipvp2.zip / RDATE2.PAS < prev    next >
Pascal/Delphi Source File  |  1996-10-10  |  4KB  |  129 lines
  1. program rdate;
  2.  
  3. {$F+}
  4.  
  5. uses OS2Def,OS2Base,DOS,
  6.      Socket,U_DateTime;
  7.  
  8. {$L IBMTCPIP.LIB}
  9.  
  10. const
  11.   Version    = '00.90';
  12.   TimServPort: ULong = 10037;
  13.   UseString:  string = '@(#)remote date via timeserver2 on Port 10037'+#0;
  14.   CopyRight1: string = '@(#)rdate for OS/2  Version '+Version+' - 10.10.96'+#0;
  15.   CopyRight2: string = '@(#)(C) Chr.Hohmann BfS ST2.2 1996'+#0;
  16. var
  17.   rc:      ApiRet;
  18.   Count,
  19.   SleepT,
  20.   ActSleep,
  21.   ActTime: ULong;
  22.   ValError,
  23.   SDescr:  longint;
  24.   SAddr:   SockAddr_In_Ptr;
  25.   BufFlag: ULong;
  26.   TempStr: string;
  27.   TempDT:  OS2Base.DateTime;
  28.   Lang:    LanguageType;
  29. begin
  30.   TempStr := getenv('TimeService2');
  31.   if (TempStr > '') then begin
  32.     val(TempStr,TimServPort,ValError);
  33.     if (ValError <> 0) and (TimServPort > 0) then begin
  34.       writeln('timserv2 error - not a value ',TempStr);
  35.       halt(99);
  36.     end;
  37.   end;
  38.   if (ParamCount = 0) then begin
  39.     writeln('usage: rdate2 host [Minutes]');
  40.     writeln('       default port is ',TimServPort);
  41.     writeln('       or via environment set TimeService2 = PortNo');
  42.     halt(1);
  43.   end else begin
  44.     TempStr := ParamStr(1);
  45.     if (TempStr[1] = '\') or (TempStr[1] = '-') then begin
  46.       writeln('usage: rdate2 host [Minutes]');
  47.       halt(1);
  48.     end;
  49.     if (ParamCount > 1) then begin
  50.       TempStr := ParamStr(2);
  51.       val(TempStr,SleepT,ValError);
  52.       if (ValError = 0) and (SleepT > 0) then begin
  53.         write  ('--------------------------------------------------------------------------------');
  54.         writeln('Startup rdate2 - Port ',TimServPort,' - Server ',ParamStr(1),' - New request every ',SleepT,' minutes');
  55.         write  ('--------------------------------------------------------------------------------');
  56.       end else begin
  57.         writeln;
  58.         writeln('rdate2: error - not a value ',TempStr);
  59.         halt(99);
  60.       end;
  61.     end else begin
  62.       SleepT := 0;
  63.     end;
  64.   end;
  65.   TempStr := getenv('LANG');
  66.   if (pos('de',TempStr) = 1) or
  67.      (pos('DE',TempStr) = 1) then
  68.     Lang := German
  69.   else
  70.     Lang := Default;
  71.   new(SAddr);
  72.   Count    := 0;
  73.   ActSleep := SleepT;
  74.   repeat
  75.     fillchar(SAddr^,sizeof(SAddr^),#0);
  76.     rc := socksocket(AF_INET,SOCK_STREAM,IPPROTO_NULL);
  77.     if (rc <> -1) then begin
  78.       SDescr := rc;
  79.       rc     := SockGetHostAddrByName(paramstr(1));
  80.       if (rc <> 0) then begin
  81.         SAddr^.Sin_Addr.IPAddr := rc;
  82.         SAddr^.Sin_Port        := htons(TimServPort);
  83.         SAddr^.Sin_Family      := AF_INET;
  84.         rc := SockConnect(SDescr,
  85.                           SAddr,
  86.                           SockAddr_Len);
  87.         if (rc <> -1) then begin
  88.           BufFlag := 0;
  89.           rc := SockRecv(SDescr,
  90.                          @TempDT,
  91.                          sizeof(TempDT),
  92.                          BufFlag);
  93.           if (rc = sizeof(TempDT)) then begin
  94.             rc := DosSetDateTime(TempDT);
  95.             if (rc = 0) then begin
  96.               writeln(Long_DateString(Lang,TempDT));
  97.               inc(Count);
  98.             end else begin
  99.               write('DosSetDateTime failed   rc = ',rc);
  100.             end;
  101.           end else begin
  102.             write('incorrect data received from server');
  103.           end;
  104.           rc := SockClose(SDescr);
  105.         end else begin
  106.           write('server ',paramstr(1),' not responding');
  107.         end;
  108.         if (rc <> 0) then begin
  109.           if (SleepT > 0) then begin
  110.             rc := 0;
  111.             writeln(' - trying again in 5 minutes');
  112.             ActSleep := 5;
  113.           end else writeln;
  114.         end;
  115.       end else begin
  116.         writeln;
  117.         writeln('server ',paramstr(1),' not found');
  118.         rc := -1;
  119.       end;
  120.     end;
  121.     if (rc <> -1) then DosSleep(ActSleep*60000);
  122.     ActSleep := SleepT;
  123.   until (rc = -1) or (SleepT = 0);
  124.   dispose(SAddr);
  125.   UseString  := UseString;
  126.   CopyRight1 := CopyRight1;
  127.   CopyRight2 := CopyRight2;
  128. end.
  129.