program saveip;

{ GetIP by ParanoidE }

{ Usage: Just exec it and it will save ip's to a file...

CLI Example:

X:\> saveip.exe mylist.txt

If the file is not specified, the list will be "iplist.txt" }

uses
  Windows,
  SysUtils,
  CmdLineHelper,
  Classes,
  Forms,
  Winsock;

{$R *.res}

var
  FinalData: String;
  FileLoaded: String;
  BasicalData: String;
  edSavefile: String;

function GetNextParam(var CmdLine: PChar; Buffer: PChar; Len: PInteger): Boolean; //Gets next param
var
  InQuotedStr, IsOdd: Boolean;
  NumSlashes, NewLen, cnt: Integer;
begin
  Result := False;
  if Len <> nil then Len^ := 0;
  if CmdLine = nil then Exit;
  while (CmdLine^ <= ' ') and (CmdLine^ <> #0) do CmdLine := CharNext(CmdLine) ;
  if CmdLine^ = #0 then Exit;
  InQuotedStr := False;
  NewLen := 0;
  repeat
    if CmdLine^ = '\' then
    begin
      NumSlashes := 0;
      repeat
        Inc(NumSlashes) ;
        CmdLine := CharNext(CmdLine) ;
      until CmdLine^ <> '\';
      if CmdLine^ = '"' then
      begin
        IsOdd := (NumSlashes mod 2) <> 0;
        NumSlashes := NumSlashes div 2;
        Inc(NewLen, NumSlashes) ;
        if IsOdd then Inc(NewLen) ;
        if Buffer <> nil then
        begin
          for cnt := 0 to NumSlashes-1 do
          begin
            Buffer^ := '\';
            Inc(Buffer) ;
          end;
          if IsOdd then
          begin
            Buffer^ := '"';
            Inc(Buffer) ;
          end;
        end;
        if IsOdd then CmdLine := CharNext(CmdLine) ;
      end else
      begin
        Inc(NewLen, NumSlashes) ;
        if Buffer <> nil then
        begin
          for cnt := 0 to NumSlashes-1 do
          begin
            Buffer^ := '\';
            Inc(Buffer) ;
          end;
        end;
      end;
      Continue;
    end;
    if CmdLine^ <> '"' then
    begin
      if (CmdLine^ <= ' ') and (not InQuotedStr) then Break;
      Inc(NewLen) ;
      if Buffer <> nil then
      begin
        Buffer^ := CmdLine^;
        Inc(Buffer) ;
      end;
    end
    else
      InQuotedStr := not InQuotedStr;
    CmdLine := CharNext(CmdLine) ;
  until CmdLine^ = #0;
  if Len <> nil then Len^ := NewLen;
  Result := True;
end;

function GetParamCount: Integer;  //Gets ParamCount
var
  CmdLine: PChar;
begin
  Result := 0;
  CmdLine := windows.GetCommandLine;
  GetNextParam(CmdLine, nil, nil) ;
  while GetNextParam(CmdLine, nil, nil) do Inc(Result) ;
end;

function GetParamStr(Index: Integer): String; //Gets the ParamStr
var
  Buffer: array[0..MAX_PATH] of Char;
  CmdLine, P: PChar;
  Len: Integer;
begin
  Result := '';
  if Index <= 0 then
  begin
    Len := GetModuleFileName(0, Buffer, MAX_PATH+1) ;
    SetString(Result, Buffer, Len) ;
  end else
  begin
    CmdLine := windows.GetCommandLine;
    GetNextParam(CmdLine, nil, nil) ;
    repeat
      Dec(Index) ;
      if Index = 0 then Break;
      if not GetNextParam(CmdLine, nil, nil) then Exit;
    until False;
    P := CmdLine;
    if GetNextParam(P, nil, @Len) then
    begin
      SetLength(Result, Len) ;
      GetNextParam(CmdLine, PChar(Result), nil) ;
    end;
  end;
end;

procedure GetParameters;  //Needed if you specify a filename
begin
If GetParamCount >= 1 then
  begin
    edSavefile:=GetParamStr(1)
  end else
  begin
    edSavefile:='iplist.txt'
  end;
end;

function GetIPFromHost //Get IP from Host
(var HostName, IPaddr, WSAErr: string): Boolean;
type
  Name = array[0..100] of Char;
  PName = ^Name;
var
  HEnt: pHostEnt;
  HName: PName;
  WSAData: TWSAData;
  i: Integer;
begin
  Result := False;
  if WSAStartup($0101, WSAData) <> 0 then begin
    WSAErr := 'Winsock doesn''t respond.';
    Exit;
  end;
  IPaddr := '';
  New(HName);
  if GetHostName(HName^, SizeOf(Name)) = 0 then
  begin
    HostName := StrPas(HName^);
    HEnt := GetHostByName(HName^);
    for i := 0 to HEnt^.h_length - 1 do
     IPaddr :=
      Concat(IPaddr,
      IntToStr(Ord(HEnt^.h_addr_list^[i])) + '.');
    SetLength(IPaddr, Length(IPaddr) - 1);
    Result := True;
  end
  else begin
   case WSAGetLastError of
    WSANOTINITIALISED:WSAErr:='WSANotInitialised';
    WSAENETDOWN      :WSAErr:='WSAENetDown';
    WSAEINPROGRESS   :WSAErr:='WSAEInProgress';
   end;
  end;
  Dispose(HName);
  WSACleanup;
end;

function LoadFile(const FileName: TFileName): string; //Loads the specified filename
begin
  with TFileStream.Create(FileName,
      fmOpenRead or fmShareDenyWrite) do begin
    try
      SetLength(Result, Size);
      Read(Pointer(Result)^, Size);
    except
      Result := '';  // Deallocates memory
      Free;
      raise;
    end;
    Free;
  end;
end;

procedure SaveFile(const FileName: TFileName; const content: string); //Saves the specified filename
begin
  with TFileStream.Create(FileName, fmCreate) do
    try
      Write(Pointer(content)^, Length(content));
    finally
      Free;
    end;
end;

procedure GetIP; //Get IP and save to a file
var
  Host, IP, Err: string;
  FileExistence: Boolean;
  FinalData: String;
begin
 if FileExists(edSavefile) then begin
 FileExistence:=True;
 end else begin
 FileExistence:=False;
 end;
 BasicalData:=
      'Gathered IP''s:'+#10#13;
  SetWindowLong(Application.Handle, GWL_EXSTYLE, WS_EX_TOOLWINDOW);
  if GetIPFromHost(Host, IP, Err) then begin
    HOST:=Host;
    IP:=IP;
  end;
If FileExistence=False then begin
FinalData:=BasicalData + Host + ' ' + IP;
SaveFile(edSavefile, FinalData);
end else begin
FinalData:=LoadFile(edSavefile)+ #13 + Host + ' ' + IP;
SaveFile(edSavefile, FinalData);
end;
end;

begin //Main block of the program
  Application.Initialize;
  Application.Title := 'GetIP';
  GetParameters;
  GetIP;
  Application.Run;
end.