'-Begin-----------------------------------------------------------------
'-Constants-----------------------------------------------------------
Const Base64 = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/"
'-Function MyASC------------------------------------------------------
'-
'- (c) 2001 Antonin Foller, Motobit Software
'- www.motobit.com/tips/detpg_base64encode/
'-
'---------------------------------------------------------------------
Function MyASC(OneChar)
If OneChar = "" Then
MyASC = 0
Else
MyASC = Asc(OneChar)
End If
End Function
'-Function Base64Encode-----------------------------------------------
'-
'- (c) 2001 Antonin Foller, Motobit Software
'- www.motobit.com/tips/detpg_base64encode/
'-
'---------------------------------------------------------------------
Function Base64Encode(inData)
'-Variables-------------------------------------------------------
Dim cOut, sOut, i, nGroup, pOut, sGroup
'For each group of 3 bytes
For i = 1 To Len(inData) Step 3
'Create one long from this 3 bytes.
nGroup = &H10000 * Asc(Mid(inData, i, 1)) + _
&H100 * MyASC(Mid(inData, i + 1, 1)) + _
MyASC(Mid(inData, i + 2, 1))
'Oct splits the long To 8 groups with 3 bits
nGroup = Oct(nGroup)
'Add leading zeros
nGroup = String(8 - Len(nGroup), "0") & nGroup
'Convert To base64
pOut = Mid(Base64, CLng("&o" & Mid(nGroup, 1, 2)) + 1, 1) + _
Mid(Base64, CLng("&o" & Mid(nGroup, 3, 2)) + 1, 1) + _
Mid(Base64, CLng("&o" & Mid(nGroup, 5, 2)) + 1, 1) + _
Mid(Base64, CLng("&o" & Mid(nGroup, 7, 2)) + 1, 1)
'Add the part To OutPut string
sOut = sOut + pOut
'Add a new line For Each 76 chars In dest (76*3/4 = 57)
'If (I + 2) Mod 57 = 0 Then
' sOut = sOut + vbCrLf
'End If
Next
Select Case Len(inData) Mod 3
Case 1: '8 bit final
sOut = Left(sOut, Len(sOut) - 2) + "=="
Case 2: '16 bit final
sOut = Left(sOut, Len(sOut) - 1) + "="
End Select
Base64Encode = sOut
End Function
'-Sub Main------------------------------------------------------------
Sub Main()
'-Variables-------------------------------------------------------
Dim Http, Authorization, User, Password, Result
Set Http = CreateObject("WinHttp.WinHttpRequest.5.1")
If IsObject(Http) Then
User = "MyUser"
Password = "Secret"
Authorization = Base64Encode(User & ":" & Password)
Http.Open "GET", "http://sid.MyHost.de:8330" & _
"/sap/opu/odata/ZDELIVERY_SRV/DeliveriesSet?$format=xml", True
Http.SetRequestHeader "Authorization", "Basic " & Authorization
Http.Send
Http.WaitForResponse 10
MsgBox Http.StatusText & vbCrLf & Http.GetAllResponseHeaders
If Http.Status = 200 Then
Result = Http.ResponseText
MsgBox Result
End If
Set Http = Nothing
End If
End Sub
'-Main----------------------------------------------------------------
Main
'-End-------------------------------------------------------------------
You must be a registered user to add a comment. If you've already registered, sign in. Otherwise, register and sign in.
User | Count |
---|---|
6 | |
6 | |
5 | |
4 | |
4 | |
3 | |
3 | |
3 | |
3 | |
3 |