home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 7 / Apprentice-Release7.iso / Source Code / Pascal / Applications / TCPExample / PNL Libraries / MyIPStrings.p < prev    next >
Encoding:
Text File  |  1996-11-09  |  2.2 KB  |  104 lines  |  [TEXT/CWIE]
  1. unit MyIPStrings;
  2.  
  3. interface
  4.  
  5.     uses
  6.         Types, OpenTptInternet;
  7.         
  8.     function StringToIPAddr (s: Str255; var addr: InetHost): boolean;
  9.     procedure IPAddrToString (ip: InetHost; var addrStr: Str255);
  10.     function IPAddrToStr (ip: InetHost): Str255;
  11.     procedure IPAddrPortToString (ip: InetHost; port: InetPort; var addrStr: Str255);
  12.     function IPAddrPortToStr (ip: InetHost; port: InetPort): Str255;
  13.     
  14. implementation
  15.     
  16.     uses
  17.         TextUtils,
  18.         MyStrings;
  19.         
  20.     function StringToIPAddr (s: Str255; var addr: InetHost): boolean;
  21.         var
  22.             good: boolean;
  23.         procedure Get1;
  24.             var
  25.                 b: integer;
  26.         begin
  27.             if (length(s) = 0) | not (s[1] in ['0'..'9']) then begin
  28.                 good := false;
  29.             end else begin
  30.                 b := ord(s[1]) - 48;
  31.                 s := TPcopy(s, 2, 255);
  32.                 if (s <> '') & (s[1] in ['0'..'9']) then begin
  33.                     b := b * 10 + ord(s[1]) - 48;
  34.                     s := TPcopy(s, 2, 255);
  35.                 end;
  36.                 if (s <> '') & (s[1] in ['0'..'9']) then begin
  37.                     b := b * 10 + ord(s[1]) - 48;
  38.                     s := TPcopy(s, 2, 255);
  39.                 end;
  40.                 if (s <> '') & (s[1] = '.') then begin
  41.                     s := TPcopy(s, 2, 255);
  42.                 end;
  43.                 if b > 255 then begin
  44.                     good := false;
  45.                     b := 0; { avoid overflow error? }
  46.                 end;
  47.                 addr := BOR(BSL(addr, 8), b);
  48.             end;
  49.         end;
  50.     begin
  51.         good := true;
  52.         addr := 0;
  53.         Get1;
  54.         Get1;
  55.         Get1;
  56.         Get1;
  57.         good := good & (s = '');
  58.         if not good then begin
  59.             addr := 0;
  60.         end;
  61.         StringToIPAddr := good;
  62.     end;
  63.  
  64.     procedure IPAddrToString (ip: InetHost; var addrStr: Str255);
  65.         function GetByte(ip: InetHost; bits: integer): Str255;
  66.             var
  67.                 t:Str255;
  68.         begin
  69.              NumToString(band(bsr(ip, bits), $00FF), t);
  70.              GetByte := t;
  71.         end;
  72.     begin
  73.         addrStr := GetByte(ip, 24);
  74.         addrStr := concat(addrStr, '.', GetByte(ip, 16));
  75.         addrStr := concat(addrStr, '.', GetByte(ip, 8));
  76.         addrStr := concat(addrStr, '.', GetByte(ip, 0));
  77.     end;
  78.  
  79.     function IPAddrToStr (ip: InetHost): Str255;
  80.         var
  81.             s: Str255;
  82.     begin
  83.         IPAddrToString(ip, s);
  84.         IPAddrToStr := s;
  85.     end;
  86.  
  87.     procedure IPAddrPortToString (ip: InetHost; port: InetPort; var addrStr: Str255);
  88.         var
  89.             ns:Str255;
  90.     begin
  91.         NumToString(port, ns);
  92.         addrStr := concat(IPAddrToStr(ip),':', ns);
  93.     end;
  94.     
  95.     function IPAddrPortToStr (ip: InetHost; port: InetPort): Str255;
  96.         var
  97.             ns:Str255;
  98.     begin
  99.         NumToString(port, ns);
  100.         IPAddrPortToStr := concat(IPAddrToStr(ip),':', ns);
  101.     end;
  102.     
  103. end.
  104.