Const CR = CHR (13)
Const LF = CHR (10)
Const HTTP_URI = "InsertHTTPURIhere"
Const HTTP_USERNAME = "httpusername"
Const HTTP_PASSWORD = "httppassword"
Dim _ptrDigest As Long
Public i_http As Long
Public PTemp
Public Batt_Volt
Public Auth_Complete As Boolean
Public HTTP_Request_Status As String *50
Public HTTPResponse As String *200
Public HTTP_AuthType As String *10 = "Digest"
Public HTTP_Result As Long = 0
Const HTTP_LineSize As Long = 8
Public HTTP_Lines(HTTP_LineSize) As String *208
Const HTTP_AuthSize As Long = 10
Public HTTP_Auth(HTTP_AuthSize) As String *112
Public HTTP_Header As String *512 = ""
Public HTTP_AuthRealm As String *32 = ""
Publi c HTTP_AuthNonce As String *64 = ""
Publi c HTTP_AuthQoP As String *5 = ""
Public MD5_Success(3) As Long
Public MD5_String(3) As String *256
Public Digest_Auth_HA1 As String *48 = ""
Public Digest_Auth_HA2 As String *48 = ""
Public Digest_Auth_Resp As String *48 = ""
Public Digest_HA1_little(4) As Long
Public Digest_HA2_little(4) As Long
Public Digest_Resp_little(4) As Long
Public Digest_HA1(4) As Long
Public Digest_HA2(4) As Long
Public Digest_Resp(4) As Long
Public Digest_NonceCount As Long = 1
Public Digest_nc As String = ""
Public Digest_cnonce_gen(2) As Long
Public Digest_cnonce As String = ""
DataTable (Test,1,-1)
DataInterval (0,2,Min,10)
Minimum (1,Batt_Volt,FP2,False,False)
Sample (1,PTemp,FP2)
EndTable
Function _HTTP__DigestStr(_method As String , _uri As String ) As Long
Dim Digest_AuthStr As String *500 = ""
Digest_NonceCount += 1
Digest_nc = FormatLong (Digest_NonceCount,"%8.8x" )
Digest_cnonce_gen(1) = INT (RND * 2^31)
Digest_cnonce_gen(2) = INT (RND * 2^31)
Sprintf (Digest_cnonce,"%8.8x%8.8x" ,Digest_cnonce_gen(1),Digest_cnonce_gen(2))
MD5_String(1) = HTTP_USERNAME+CHR (58)+HTTP_AuthRealm+CHR (58)+HTTP_PASSWORD
MD5_String(2) = _method+CHR (58)+_uri
MD5_Success(1) = CheckSum (MD5_String(1),29,0,Digest_HA1_little())
MD5_Success(2) = CheckSum (MD5_String(2),29,0,Digest_HA2_little())
MoveBytes (Digest_HA1(),0,Digest_HA1_little(),0,16,4)
MoveBytes (Digest_HA2(),0,Digest_HA2_little(),0,16,4)
Sprintf (Digest_Auth_HA1,"%8.8x%8.8x%8.8x%8.8x" ,Digest_HA1(1),Digest_HA1(2), _
Digest_HA1(3),Digest_HA1(4))
Sprintf (Digest_Auth_HA2,"%8.8x%8.8x%8.8x%8.8x" ,Digest_HA2(1),Digest_HA2(2), _
Digest_HA2(3),Digest_HA2(4))
MD5_String(3) = Digest_Auth_HA1+CHR (58)+HTTP_AuthNonce+CHR (58)+Digest_nc+ _
CHR (58)+Digest_cnonce+CHR (58)+HTTP_AuthQoP+CHR (58)+Digest_Auth_HA2
MD5_Success(3) = CheckSum (MD5_String(3),29,0,Digest_Resp_little())
MoveBytes (Digest_Resp(),0,Digest_Resp_little(),0,16,4)
Sprintf (Digest_Auth_Resp,"%8.8x%8.8x%8.8x%8.8x" ,Digest_Resp(1), _
Digest_Resp(2),Digest_Resp(3),Digest_Resp(4))
Digest_AuthStr = "Authorization: Digest"
Digest_AuthStr += " username=" +CHR (34)+HTTP_USERNAME+CHR (34)
Digest_AuthStr += ", realm=" +CHR (34)+HTTP_AuthRealm+CHR (34)
Digest_AuthStr += ", nonce=" +CHR (34)+HTTP_AuthNonce+CHR (34)
Digest_AuthStr += ", uri=" +CHR (34)+_uri+CHR (34)
Digest_AuthStr += ", algorithm=MD5"
Digest_AuthStr += ", response=" +CHR (34)+Digest_Auth_Resp+CHR (34)
Digest_AuthStr += ", qop=" +CHR (34)+HTTP_AuthQoP+CHR (34)
Digest_AuthStr += ", nc=" +Digest_nc
Digest_AuthStr += ", cnonce=" +CHR (34)+Digest_cnonce+CHR (34)
Return @Digest_AuthStr
EndFunction
Sub HTTP__AuthCheck
Dim i_ac As Long , j_ac As Long
SplitStr (HTTP_Lines,HTTP_Header, CR + LF ,HTTP_LineSize,5)
For i_ac = 1 To HTTP_LineSize
If InStr (1,HTTP_Lines(i_ac),"Digest" ,2) Then
HTTP_AuthType = "Digest"
SplitStr (HTTP_Auth,HTTP_Lines(i_ac),CHR (34),HTTP_AuthSize,5)
For j_ac = 1 To HTTP_AuthSize
If InStr (1,HTTP_Auth(j_ac),"realm" ,2) Then HTTP_AuthRealm = _
HTTP_Auth(j_ac+1)
If InStr (1,HTTP_Auth(j_ac),"nonce" ,2) Then HTTP_AuthNonce = _
HTTP_Auth(j_ac+1)
If InStr (1,HTTP_Auth(j_ac),"qop" ,2) Then HTTP_AuthQoP = _
HTTP_Auth(j_ac+1)
Next j_ac
ElseIf InStr (1,HTTP_Lines(i_ac),"Basic" ,2)
HTTP_AuthType = "Basic"
SplitStr (HTTP_Auth,HTTP_Lines(i_ac),CHR (34),HTTP_AuthSize,5)
For j_ac = 1 To HTTP_AuthSize
If InStr (1,HTTP_Auth(j_ac),"realm" ,2) Then HTTP_AuthRealm = _
HTTP_Auth(j_ac+1)
Next j_ac
EndIf
Next i_ac
HTTP_Request_Status = "HTTP AUTH updated"
EndSub
Sub HTTP__GET
HTTP_Request_Status = "HTTP (GET) Occuring"
HTTP_Result = HTTPGet (HTTP_URI,HTTPResponse,HTTP_Header,7500)
HTTP_Request_Status = "Server Response = "
If InStr (1,HTTPResponse,"401" ,2) Then
HTTP_Request_Status &= "unauthorized"
Auth_Complete = False
Digest_NonceCount = 0
Call HTTP__AuthCheck
ElseIf InStr (1,HTTPResponse,"200" ,2) Then
HTTP_Request_Status &= "success"
Auth_Complete = True
ElseIf InStr (1,HTTPResponse,"204" ,2) Then
HTTP_Request_Status &= "success, no content"
Auth_Complete = True
Else
HTTP_Request_Status &= "fail, unknown response"
Auth_Complete = False
EndIf
EndSub
-
BeginProg
Scan (2,Min,0,0)
PanelTemp (PTemp,50)
Battery (Batt_Volt)
CallTable Test
NextScan
SlowSequence
Scan (60,Min,0,0)
For i_http = 1 To 5
Select Case i_http
Case 1
HTTP_Header = ""
Call HTTP__GET()
Case Is > 1
HTTP_Header = "Connection: keep-alive" + CR + LF
_ptrDigest = _HTTP__DigestStr("GET" ,HTTP_URI)
HTTP_Header += !(String!)_ptrDigest + CR + LF
HTTP_Header += "Accept: */*" + CR + LF
Call HTTP__GET()
EndSelect
If Auth_Complete = True Then ExitFor
Next i_http
NextScan
EndSequence
EndProg
|