Ver Mensaje Individual
  #11  
Antiguo 23-04-2018
Dark_Code Dark_Code is offline
Miembro
NULL
 
Registrado: ene 2018
Posts: 11
Reputación: 0
Dark_Code Va por buen camino
Cita:
Empezado por Neftali [Germán.Estévez] Ver Mensaje
Estos datos no me dan acceso.
Error de usuario y/o contraseña incorrectos.


Nueva Cuenta Registrada:

USUARIO: DarkCode99
CONTRASEÑA: clubdelphi

Foro: https://www.worldhack.net/foro/login.php


Código Delphi [-]
uses WinInet;

function URLEncode(Str: string): string;
var
  i: integer;
begin
  Result:= '';
  for i:= 1 to Length(Str) do
    if Str[i] in ['A'..'Z','a'..'z','0'..'9','-','_','.'] then
      Result:= Result + Str[ i ]
    else
      Result:= Result + '%' + IntToHex(Ord(Str[ i ]),2);
end;

function SendRequest(Server, Uri: string; Port: Word; Params: TStringList;
  Response: TStream): Boolean;
var
  hNet: HINTERNET;
  hCon: HINTERNET;
  hReq: HINTERNET;
  Context: DWORD;
  Buffer: array[0..10240] of Char;
  BytesRead: DWORD;
  i: integer;
  Str: String;
  Success: Boolean;
begin
  Context:= 0;
  Result := FALSE;
  hNet := InternetOpen('Agente', INTERNET_OPEN_TYPE_PRECONFIG, nil, nil, 0);
  if (hNet <> nil) then
  begin
    hCon:= InternetConnect(hNet,PChar(Server),Port,nil,nil,
      INTERNET_SERVICE_HTTP,0,Context);
    if (hCon <> nil) then
    begin
      if Params <> nil then
        hReq:= HttpOpenRequest(hCon,'POST',PChar(Uri),nil,nil,nil,
          INTERNET_FLAG_RELOAD,Context)
      else
        hReq:= HttpOpenRequest(hCon,'GET',PChar(Uri),nil,nil,nil,
          INTERNET_FLAG_RELOAD,Context);
      if (hReq <> nil) then
      begin
        if Params <> nil then
        begin
          Str:= Emptystr;
          for i:= 0 to Params.Count - 1 do
            Str:= Str + '&' + URLEncode(Params.Names[i]) + '=' +
              URLEncode(Params.ValueFromIndex[i]);
          Delete(Str,1,1);
          Success:= HttpSendRequest(hReq,
           'Content-Type: application/x-www-form-urlencoded',Cardinal(-1),
            PChar(Str),Length(Str));
        end else
          Success:= HttpSendRequest(hReq,nil,0,nil,0);
        if Success and (Response <> nil) then
        try
          while (InternetReadFile(hReq,@Buffer,sizeof(Buffer),BytesRead)) do
          begin
            if (BytesRead = 0) then
            begin
              Result := TRUE;
              break;
            end;
            Response.Write(Buffer,BytesRead);
          end;
        except end;
        InternetCloseHandle(hReq);
      end;
      InternetCloseHandle(hCon);
    end;
    InternetCloseHandle(hNet);
  end;
end;

procedure TfrmMain.btn1Click(Sender: TObject);
var
  Campos: TStringlist;
  Respuesta: TStringStream;
begin
  txtInfo.Clear;
  Application.ProcessMessages;
  txtUsuario.Text:= Trim(txtUsuario.Text);
  txtPassword.Text:= Trim(txtPassword.Text);
  if (txtUsuario.Text = EmptyStr) or (txtPassword.Text = EmptyStr) then
  begin
    txtInfo.Lines.Add('Introduce el nombre de usuario y contraseña');
    Exit;
  end;
  Campos:= TStringList.Create;
  Respuesta:= TStringStream.Create('');
  try
    Campos.Values['vb_login_username']:= txtUsuario.Text;
    Campos.Values['vb_login_password']:= txtPassword.Text;
    Campos.Values['do']:= 'login';
    txtInfo.Lines.Add('Enviando usuario y contraseña');
    if SendRequest('www.worldhack.net','/foro/login.php',80,Campos,Respuesta) then
    begin
      if Pos('Gracias',Respuesta.DataString) > 0 then
      begin
        FreeAndNil(Respuesta);
        Respuesta:= TStringStream.Create('');
        txtInfo.Lines.Add('Usuario Conectado Correctamente');
      end else txtInfo.Lines.Add('El usuario o la contraseña no son validos');
    end else txtInfo.Lines.Add('No puedo acceder al servidor');
  finally
    Campos.Free;
    Respuesta.Free;
  end;
end;

Ese codigo estoy que uso, pero lo que pasa es que al ingresar con mis datos ID y Password, no se puede conectar al foro.
Archivos Adjuntos
Tipo de Archivo: rar Login Foro Delphi.rar (3,9 KB, 1 visitas)

Última edición por Dark_Code fecha: 23-04-2018 a las 17:48:01.
Responder Con Cita