Cara Buat Tunnel Sock to Tap dan Tun2Sock Dengan Delphi 7

Pagi Semuanya Kali ini Saya cuman mau berbagi tips Cara Membuat Tunnel Sock to Tap dan Tun2Sock Dengan Delphi 7 Terbaru 2015 mungkin saja dari kedua tunnel ini baik Sock To Tap maupun Tun2 Socks bisa anda manfaatkan dan gunakan, tetapi sebelum saya berikan cara buatnya saya akan coba jelaskan dulu sedikit saja yah, Sock To Tap adalah sebuah tools untuk HTTP Proxy yang dimana layer ini hampir mirip dengan proxifier yang sudah ada dimana mana, seperti halnya dengan tun2socks hampir sama tetapi jelas ada perbedaannya, oh iya sebelumnya saya sudah berbagi Source Code Open VPN Delphi 7 Auto Reconnect ya udah untuk kegunaan lebih jelasnya dan perbedaannya silahkan agan cari di mbah google saja yah, ya udah yuk kita langsung praktek.

1. Langkah pertama biasa buka program delphi anda lalu buka saja,, sediakan komponen: Edit (3) XPManifest (1) Button (3) Label (3) Combobox (1) Memo(1) Timer (1) Doscommand (1) silahkan atur dulu untuk nama namanya.

2. Yang kedua lalu masukan kode ini:  dsiwin32, ShellAPI, TlHelp32 pada uses.

 3. Yang ketiga tambahkan dulu kode ini  function getDNS: TStrings;dan kode  RasMonitor: TRasMonitor;
  TunAdaptorList : TStrings;  useTun2Sock : Boolean = False; lihat gambar bawah ini:

4. Yang keempat yaitu tambahkan dulu kode di bawah ini tepat dibawah tulisan implementation

uses WbemScripting_TLB, activex;

type TIWrapper=class
     public
       prop:ISWbemProperty;
       constructor Create(p:ISWbemProperty);
     end;

constructor TIWrapper.Create(p: ISWbemProperty);
begin
  prop:=p;
end;

procedure clear(Adapters:TStrings);
var i:integer;
begin
  for i:=1 to Adapters.Count do
  begin
    Adapters.Objects[i-1].Free;
    Adapters.Objects[i-1]:=nil;
  end;
  Adapters.Clear;
end;

function getPropValue(sprop:ISWbemProperty):string;
var sValue:string;
    count:integer;
begin
  sValue := '';
  if VarIsNull(SProp.Get_Value) then
    sValue := '<empty>'
  else
  case SProp.CIMType of
    wbemCimtypeSint8, wbemCimtypeUint8, wbemCimtypeSint16, wbemCimtypeUint16,
    wbemCimtypeSint32, wbemCimtypeUint32, wbemCimtypeSint64:
      sValue := IntToStr(SProp.Get_Value);
    wbemCimtypeString, wbemCimtypeUint64:
      if VarIsArray(SProp.Get_Value) then
      begin
        if VarArrayHighBound(SProp.Get_Value, 1) > 0 then
          for Count := 1 to VarArrayHighBound(SProp.Get_Value, 1) do
            sValue := sValue + ' ' + SProp.Get_Value[Count];
      end
    else
      sValue :=  SProp.Get_Value;
    wbemCimtypeDatetime:sValue:=SProp.Get_Value//DateTimeToStr(SProp.Get_Value)
  else
      Exception.Create('Unknown type');
  end; {case}
  result:=sValue;
end;

procedure getAdapters(owner:TComponent; RemoteMachine,RemoteUser,RemotePassword:string; Adapters:TStrings);
const
cWQL = 'SELECT NetConnectionID, NetConnectionStatus FROM Win32_NetworkAdapter Where Manufacturer = ''TAP-Win32 Provider V9?';
var
  Locator: TSWbemLocator;
  SinkClasses: TSWbemSink;

  Services:   ISWbemServices;
  ObjectSet:  ISWbemObjectSet;
  SObject:    ISWbemObject;
  propSet :   ISWbemPropertySet;
  SProp:      ISWbemProperty;
  Enum:       IEnumVariant;
  tempObj:    OleVariant;
  Value:      Cardinal;

  sValue,
  className:     String;
  strQuery:   WideString;
begin
  className:='WIN32_NetworkAdapter';
  clear(adapters);

  Locator:=TSWbemLocator.Create(owner);
  SinkClasses:=TSWbemSink.Create(owner);
  try
    SinkClasses.Cancel;

    if RemoteMachine='' then
      RemoteMachine:='.';// local machine
    Services := Locator.ConnectServer(RemoteMachine, 'root\CIMV2', RemoteUser, RemotePassword, '',
      '', 0, nil);
    try
      ObjectSet := Services.InstancesOf(className, wbemFlagReturnImmediately or wbemQueryFlagShallow, nil);
      Enum :=  (ObjectSet._NewEnum) as IEnumVariant;
      try
        while (Enum.Next(1, tempObj, Value) = S_OK) do
        begin
          SObject := IUnknown(tempObj) as SWBemObject;
          propSet := SObject.Properties_;
          SProp:=propSet.Item('NetConnectionID',0);// caption or systemname
          // now get the value of the property
          sValue:=getPropValue(SProp);
          try
            if sValue<>'<empty>' then
            begin
              sProp:=propSet.Item('NetConnectionStatus',0);
              Adapters.AddObject(sValue,TIWrapper.Create(SProp));
            end;
          finally
            SObject:=nil;
            propSet:=nil;
            SProp:=nil;
          end;
        end; {while Enum}
      finally
        ObjectSet:=nil;
        enum:=nil;
      end;

      strQuery := 'SELECT * FROM __InstanceCreationEvent within 5 WHERE TargetInstance' +
        ' ISA "'+className+'"';
      Services.ExecNotificationQueryAsync(SinkClasses.DefaultInterface, strQuery, 'WQL', 0, nil, nil);
        strQuery := 'SELECT * FROM __InstanceDeletionEvent within 5 WHERE TargetInstance' +
        ' ISA "'+className+'"';
      Services.ExecNotificationQueryAsync(SinkClasses.DefaultInterface, strQuery, 'WQL', 0, nil, nil);
    finally
      Services:=nil;// make sure the references are decreased
    end;
  finally
    Locator.Free;
    SinkClasses.Free;
  end; {try}
end;

function processExists(exeFileName: string): Boolean;
var
  ContinueLoop: BOOL;
  FSnapshotHandle: THandle;
  FProcessEntry32: TProcessEntry32;
begin
  FSnapshotHandle := CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0);
  FProcessEntry32.dwSize := SizeOf(FProcessEntry32);
  ContinueLoop := Process32First(FSnapshotHandle, FProcessEntry32);
  Result := False;
  while Integer(ContinueLoop) <> 0 do
  begin
    if ((UpperCase(ExtractFileName(FProcessEntry32.szExeFile)) =
      UpperCase(ExeFileName)) or (UpperCase(FProcessEntry32.szExeFile) =
      UpperCase(ExeFileName))) then
    begin
      Result := True;
    end;
    ContinueLoop := Process32Next(FSnapshotHandle, FProcessEntry32);
  end;
  CloseHandle(FSnapshotHandle);
end;

function KillTask(ExeFileName: string): Integer;
const
  PROCESS_TERMINATE = $0001;
var
  ContinueLoop: BOOL;
  FSnapshotHandle: THandle;
  FProcessEntry32: TProcessEntry32;
begin
  Result := 0;
  FSnapshotHandle := CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0);
  FProcessEntry32.dwSize := SizeOf(FProcessEntry32);
  ContinueLoop := Process32First(FSnapshotHandle, FProcessEntry32);
  while Integer(ContinueLoop) <> 0 do
  begin
    if ((UpperCase(ExtractFileName(FProcessEntry32.szExeFile)) =
      UpperCase(ExeFileName)) or (UpperCase(FProcessEntry32.szExeFile) =
      UpperCase(ExeFileName))) then
      Result := Integer(TerminateProcess(
                        OpenProcess(PROCESS_TERMINATE,
                                    BOOL(0),
                                    FProcessEntry32.th32ProcessID),
                                    0));
     ContinueLoop := Process32Next(FSnapshotHandle, FProcessEntry32);
  end;
  CloseHandle(FSnapshotHandle);
end;

5. Yang kelima tambahkan dulu kode dibawah ini tepat dibawah kode {$R *.dfm}

function TForm1.getDNS: TStrings;
var
  DNSnum, ErrorCode: integer ;
  NetworkParams: TNetworkParams ;
begin
  Result := TStringList.Create;
  ErrorCode := IpHlpNetworkParams (NetworkParams) ;
  if ErrorCode = 0 then
  begin
  with NetworkParams do
    begin
      if DnsServerTot <> 0 then
      begin
        for DNSnum := 0 to Pred (DnsServerTot) do
          if DnsServerNames[DNSnum] <> '192.168.1.1' then
            Result.Add(DnsServerNames[DNSnum]);
      end ;
    end;
  end;

6. Yang keenam masuk ke Form1 object inspector > event > oncreate lalu masukan kode dibawah, perhatikan tulisan beginnya.

var
  tit : string;
begin
  tit := 'Tun2Sock Capsa';
  Application.Title := tit;
  Form1.Caption := tit;
  RasMonitor:= TRasMonitor.Create(nil);
  getAdapters(self, '', '', '', ComboBox1.items);
  ComboBox1.ItemIndex := 0;
end;

7. Yang ketujuhmasih ditempat sama dengan gambar 6 diatas hanya saja anda klik onclose lalu masukan kode KillTask('tun2socks.exe');

8. Yang kedelapan yaitu Double klik Button 1 atau pilih onclick di menu event dan sama saja biar cepat double klik saja button 1 lalu masukan kode:

var
  doscommand  : TDosCommand;
  tunparam    : string;
  tun2sockdir : string;
begin
  if useTun2Sock then begin
    Memo1.Clear;
    KillTask('badvpn-tun2socks.exe');
  end
  else begin
    Memo1.Clear;
    doscommand := TDosCommand.Create(nil);
    tun2sockdir := ExtractFilePath(ParamStr(0)) + '\tun2sock\';
    tunparam := 'netsh interface ip set address "'+ ComboBox1.Text +'" static 10.0.0.1 255.255.255.0 & ' +
      'badvpn-tun2socks --tundev "tap0901:'+ ComboBox1.Text +':10.0.0.1:10.0.0.0:255.255.255.0" --netif-ipaddr 10.0.0.2 --netif-netmask 255.255.255.0 --socks-server-addr '+ Edit1.Text +':' + Edit2.Text;
    doscommand.CommandLine := 'cmd /C cd ' + tun2sockdir + ' & ' + tunparam;
    doscommand.OutputLines := Memo1.Lines;
    doscommand.Execute;
  end;

9.yaang kesembilan lalu double klik Button 2 lalu masukan kode:

  ShellExecute(Application.Handle,'open','tapinstall.exe',PChar('install "OemWin2k.inf" tap0901'),nil,SW_HIDE);
  repeat
  until not processExists('tapinstall.exe');
  getAdapters(self, '', '', '', ComboBox1.items);
  ComboBox1.ItemIndex := ComboBox1.Items.Count - 1;

10. Ynag kesepuluh double klik button 3 lalu masukan kode dibawah ini:

  ShellExecute(Application.Handle,'open','tapinstall.exe',PChar('remove tap0901'),nil,SW_HIDE);
  repeat
  until not processExists('tapinstall.exe');
  getAdapters(self, '', '', '', ComboBox1.items);
  ComboBox1.ItemIndex := ComboBox1.Items.Count - 1;

11. Yang kesebelas sekaligus yang terakhir yaitu double klik Timer1 lalu masukan kode dibawah ini:

 dsiwin32.DSiTrimWorkingSet;
  if processExists('badvpn-tun2socks.exe') then begin
    useTun2Sock := True;
    Button1.Caption := 'Stop Tun2Sock';
  end
  else begin
    useTun2Sock := False;
    Button1.Caption := 'Start Tun2Sock';
  end;

Dan berikut contoh jadinya yang sudah dibuat:

Ya udah dulu Cara Buat Tunnel Sock to Tap dan Tun2Sock Dengan Delphi 7 untuk sok to tapnya ditunggu saja ya dipostingan selanjutnya semoga bermanfaat dan terima kasih.. ass..oh iya hampir lupa untuk folder tambahannya silahkan download DIMARI cantik dan ganteng passrarnya aimeegracecatering.blogspot.com ...

Post Selanjutnya; Cara Menghilangkan Windows Genuine Activation Pada Windows 7

CAPSA (Cara Apa Saja) Informasi Download Lagu dan Proxy Free Full Version Blogger