icsntlmmsgs.pas

BaiduMp3 search baidu mp3

    PassHash : String;
begin
    Pass := Copy(UpperCase(APassword), 1, 14);
    for I := Length(APassword) to 14 do
        Pass := Pass + #0;

    PassHash := DesEcbEncrypt(Copy(Pass, 1, 7),  Magic) +
                DesEcbEncrypt(Copy(Pass, 8, 7), Magic) +
                #0#0#0#0#0;

    Result := DesEcbEncrypt(Copy(PassHash,  1, 7), ANonce) +
              DesEcbEncrypt(Copy(PassHash,  8, 7), ANonce) +
              DesEcbEncrypt(Copy(PassHash, 15, 7), ANonce);
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
function NtlmGetNTHash(
    const APassword : String;
    const ANonce    : TArrayOf8Bytes): String;
var
    PassHash: String;
begin
    PassHash := MD4String(Unicode(APassword)) + #0#0#0#0#0;
    Result   := DesEcbEncrypt(Copy(PassHash,  1, 7), ANonce) +
                DesEcbEncrypt(Copy(PassHash,  8, 7), ANonce) +
                DesEcbEncrypt(Copy(PassHash, 15, 7), ANonce);
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
function NtlmGetMessage1(const AHost, ADomain: String): String;
var
    Msg         : TNTLM_Message1;
    MessageAux  : String;
    Host        : String;
    Domain      : String;
begin
    Host   := UpperCase(AHost);
    Domain := UpperCase(ADomain);

    FillChar(Msg, SizeOf(Msg), #0);
    // signature
    Move('NTLMSSP' + #0, Msg.Protocol, 8);

    // message type (negotiate)
    Msg.MsgType := 1;

    // prepare flags
    Msg.Flags := Flags_Negotiate_Unicode or
                 Flags_Negotiate_OEM or
                 Flags_Request_Target or
                 Flags_Negotiate_NTLM or
                 Flags_Negotiate_Allways_Sign { or
                 Flags_Negotiate_NTLM2_Key};

    // host and/or domain supplied ?
    // host
    if Length(Host) > 0 then
         Msg.Flags := Msg.Flags or Flags_Negotiate_Workstation_Supplied;

    // domain
    if Length(Domain) > 0 then
         Msg.Flags := Msg.Flags or Flags_Negotiate_Domain_Supplied;

    // host
    Msg.Host.Length := Length(Host);
    Msg.Host.Space  := Msg.Host.Length;

    if Msg.Host.Length > 0 then
        Msg.Host.Offset := $20
    else
        Msg.Host.Offset := 0;

    // domain
    Msg.Domain.Length := Length(Domain);
    Msg.Domain.Space  := Msg.Domain.Length;

    if Msg.Domain.Length > 0 then
         Msg.Domain.Offset := Msg.Host.Offset + Msg.Domain.Length
    else
         Msg.Domain.Offset := 0;

    SetLength(MessageAux, SizeOf(Msg));
    Move(Msg, MessageAux[1], SizeOf(Msg));
    MessageAux := MessageAux + Host + Domain;

    Result := Base64Encode(MessageAux);
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
function NtlmGetMessage2(const AServerReply: String): TNTLM_Msg2_Info;
var
    Msg         : TNTLM_Message2;
    MsgInfo     : TNTLM_Msg2_Info;
    InfoType    : Word;
    InfoLength  : Word;
    InfoStr     : WideString;
    I           : Integer;
    NTLMReply   : String;
begin
    NTLMReply  := Base64Decode(AServerReply);

    if Length(AServerReply) > 0 then begin
        // we have a response
        MsgInfo.SrvRespOk := TRUE;
        Move(NTLMReply[1], Msg, SizeOf(Msg));
        // extract target
        MsgInfo.Target := Copy(NTLMReply, Msg.TargetName.Offset + 1,
                               Msg.TargetName.Length);
        // extract challenge
        Move(Msg.Challenge, MsgInfo.Challenge, SizeOf(Msg.Challenge));
        // let's extract the other information
        I := Msg.TargetInfo.Offset + 1;
        // loop through target information blocks
        while I < Length(NTLMReply) do begin
            // extract type
            Move(NTLMReply[I], InfoType, SizeOf(InfoType));
            I := I + SizeOf(InfoType);
            // extract length
            Move(NTLMReply[I], InfoLength, SizeOf(InfoLength));
            I := I + SizeOf(InfoLength);
            // terminator block ?
            if (InfoType = 0) and (InfoLength = 0) then
                break
            else begin
                // extract information
                InfoStr := Copy(NTLMReply, I, InfoLength);
                if InfoType = TIB_Type_Server then
                    MsgInfo.Server := InfoStr
                else if InfoType = TIB_Type_Domain then
                    MsgInfo.Domain := InfoStr;
                // jump to next block
                I := I + InfoLength;
            end;
        end;
    end
    else begin
        // no response from server
        MsgInfo.SrvRespOk := FALSE;
    end;
    Result := MsgInfo;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
function NtlmGetMessage3(const ADomain, AHost, AUser,
  APassword: String; AChallenge: TArrayOf8Bytes): String;
var
    Msg        : TNTLM_Message3;
    MessageAux : String;
    LM_Resp    : String[30];
    NT_Resp    : String[30];
    UDomain    : String;
    UHost      : String;
    UUser      : String;
begin
    UDomain    := Unicode(ADomain);
    UHost      := Unicode(AHost);
    UUser      := Unicode(AUser);
    FillChar(Msg, SizeOf(Msg), #0);
    Move('NTLMSSP' + #0, Msg.Protocol, 8);
    Msg.MsgType := 3;

    // prepare domain
    Msg.Domain.Length := Length(UDomain);
    Msg.Domain.Space  := Msg.Domain.Length;
    Msg.Domain.Offset := $40;

    // prepare user
    Msg.User.Length   := Length(UUser);
    Msg.User.Space    := Msg.User.Length;
    Msg.User.Offset   := Msg.Domain.Offset + Msg.Domain.Length;

    // preapre host
    Msg.Host.Length   := Length(UHost);
    Msg.Host.Space    := Msg.Host.Length;
    Msg.Host.Offset   := Msg.User.Offset + Msg.User.Length;

    // prepare LM and NTLM responses
    Msg.LM.Length     := $18;
    Msg.LM.Space      := Msg.LM.Length;
    Msg.LM.Offset     := Msg.Host.Offset + Msg.Host.Length;

    Msg.NTLM.Length   := $18;
    Msg.NTLM.Space    := Msg.LM.Length;
    Msg.NTLM.Offset   := Msg.LM.Offset + Msg.LM.Length;

    // no session key
    Msg.SessionKey.Length := 0;
    Msg.SessionKey.Space  := 0;
    Msg.SessionKey.Offset := 0;

    // prepare flags
    Msg.Flags := Flags_Negotiate_Unicode or
                 Flags_Request_Target or
                 Flags_Negotiate_NTLM or
                 Flags_Negotiate_Allways_Sign {or
                 Flags_Negotiate_NTLM2_Key};

    LM_Resp := NtlmGetLMHash(APassword, AChallenge);
    NT_Resp := NtlmGetNTHash(APassword, AChallenge);

    SetLength(MessageAux, SizeOf(Msg));
    Move(Msg, MessageAux[1], SizeOf(Msg));

    MessageAux := MessageAux + UDomain + UUser + UHost + LM_Resp + NT_Resp;

    Result := Base64Encode(MessageAux);
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

end.