Why point insertion giving error? - mysql
I am using this statement to insert data into database.
cursor.execute('INSERT INTO scats_data(id,geometry,NB_SCATS_SITE,QT_INTERVAL_COUNT,NB_DETECTOR,DAY_OF_WEEK,V00,V01,V02,V03,V04,V05,\
V06,V07,V08,V09,V10,V11,V12,V13,V14,V15,V16,V17,V18,V19,V20,V21,V22,V23,V24,V25,V26,V27,V28,V29,V30,V31,V32,V33,V34,V35,V36,\
V37,V38,V39,V40,V41,V42,V43,V44,V45,V46,V47,V48,V49,V50,V51,V52,V53,V54,V55,V56,V57,V58,V59,V60,V61,V62,V63,V64,V65,V66,V67,V68,\
V69,V70,V71,V72,V73,V74,V75,V76,V77,V78,V79,V80,V81,V82,V83,V84,V85,V86,V87,V88,V89,V90,V91,V92,V93,V94,V95,DS_LOCATION,NB_LANE,\
LANE_MVT,LOC_MVT,HF,unique_road )' \
'VALUES("%s", ST_GeomFromText("%s"),"%s", "%s","%s", "%s", "%s","%s", "%s", "%s","%s", "%s", "%s","%s", "%s", "%s","%s", "%s", "%s","%s", "%s",\
"%s", "%s", "%s","%s", "%s", "%s","%s", "%s", "%s","%s", "%s", "%s","%s", "%s", "%s","%s", "%s", "%s","%s", "%s",\
"%s", "%s", "%s","%s", "%s", "%s","%s", "%s", "%s","%s", "%s", "%s","%s", "%s", "%s","%s", "%s", "%s","%s", "%s",\
"%s", "%s", "%s","%s", "%s", "%s","%s", "%s", "%s","%s", "%s", "%s","%s", "%s", "%s","%s", "%s", "%s","%s", "%s",\
"%s", "%s", "%s","%s", "%s", "%s","%s", "%s", "%s","%s", "%s", "%s","%s", "%s", "%s","%s", "%s", "%s","%s", "%s",\
"%s", "%s", "%s","%s", "%s", "%s",ST_GeomFromText("%s"))',row)
Now to insert geometry i reffered this link (http://dev.mysql.com/doc/refman/5.7/en/populating-spatial-columns.html) and it says INSERT INTO geom VALUES (ST_GeomFromText('POINT(1 1)'));
In SQL data is stored like this: 6828-1-1418515200000,POINT (142.4685224783753 -38.369480766871604),6828,2014-12-14T00:00:00.000Z
So I think if I think %s will be replaced by ,POINT (142.4685224783753 -38.369480766871604) which is same query as in MySQL tutorial.
But, its giving error IntegrityError: 1048 (23000): Column 'geometry' cannot be null.
row values
6828-1-1418515200000,POINT (142.4685224783753 -38.369480766871604),6828,2014-12-14T00:00:00.000Z,1,Sun,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,0,0,0,0,0,1,2,3,0,1,0,3,3,1,3,1,1,1,0,0,0,1,1,1,0,1,3,0,2,2,1,4,3,2,1,0,1,1,1,6,3,54,0,2,0,1,1,0,3,1,0,1,1,2,2,0,0,1,2,0,0,0,0,1,PRINCES HWY E OF LAVEROCK GRV,1,LEFT,ALL MOVES,11021,"MULTILINESTRING ((142.48801034854367 -38.381874507510574, 142.48570966059145 -38.380847669922076, 142.4834205640538 -38.37982518177907, 142.48163035372713 -38.37813371108973, 142.47989576432153 -38.37638226868625, 142.4780618391024 -38.37456025481361, 142.4777347288131 -38.374223298652254, 142.47742304568112 -38.3739738685488, 142.47712825035373 -38.37374407278146, 142.47577221023352 -38.37300570096153, 142.47481033576847 -38.372453092845404, 142.4740356560262 -38.37205034193404, 142.47280364651544 -38.371564735815014, 142.4694940306536 -38.370177144007, 142.46895950092957 -38.36993346030617, 142.4684829975748 -38.3696658943809, 142.46804910524443 -38.36940724743188, 142.46437932942334 -38.36724871261641, 142.46400949840813 -38.367014127924854, 142.46369738267254 -38.366842233151786, 142.45993341846577 -38.36463147890183, 142.45960729346984 -38.364437887024344))"
Related
Object Required Error with JSON to VBA converting Process
I got an error message
Run-Time '424' Object Required
when I click to debug it highlights this section to me For Each Value In Parsed("model")
Code is like below;
Sub Test1()
Dim FSO As New FileSystemObject
Dim JsonTS As TextStream
Dim JsonText As String
Dim Parsed As Scripting.Dictionary
' Read .json file
Set JsonTS = FSO.OpenTextFile("\exampleJSON.json", ForReading)
JsonText = JsonTS.ReadAll
JsonTS.Close
' Parse json to Dictionary
' "values" is parsed as Collection
' each item in "values" is parsed as Dictionary
Set Parsed = JsonConverter.ParseJson(JsonText)
' Prepare and write values to sheet
Dim Values As Variant
ReDim Values(Parsed("model").Count, 3)
Dim Value As Dictionary
Dim i As Long
i = 0
For Each Value In Parsed("model")
Values(i, 0) = Value("name")
Values(i, 1) = Value("type")
Values(i, 2) = Value("window")
i = i + 1
Next Value
Sheets("TEST_SHEET").Range(Cells(1, 1), Cells(Parsed("model").Count, 3)) = Values
End Sub
And the JSON file is like that:
{"model": {
"name": "Hakan",
"type": "on",
"window": {
"title": "Sample Konfabulator Widget",
"name": "main_window",
"width": 500,
"height": 500
},
"image": {
"src": "Images/Sun.png",
"name": "sun1",
"hOffset": 250,
"vOffset": 250,
"alignment": "center"
},
"text": {
"data": "Click Here",
"size": 36,
"style": "bold",
"name": "text1",
"hOffset": 250,
"vOffset": 100,
"alignment": "center",
"onMouseUp": "sun1.opacity = (sun1.opacity / 100) * 90;"
}
}}
What's the problem caused do you have any idea why there's not any object seen in VBA?
Try the below example to convert each model property into row of the table, and output the result to worksheet. Import JSON.bas module into the VBA project for JSON processing.
Option Explicit
Sub Test()
Dim sJSONString As String
Dim vJSON As Variant
Dim sState As String
Dim aData()
Dim aHeader()
' Read JSON
sJSONString = ReadTextFile(ThisWorkbook.Path & "\source.json", -2)
' Parse JSON
JSON.Parse sJSONString, vJSON, sState
If sState = "Error" Then MsgBox "Invalid JSON": Exit Sub
' Output "model" to the worksheet
JSON.ToArray vJSON("model"), aData, aHeader
With Sheets(1)
.Cells.Delete
OutputArray .Cells(1, 1), aHeader
Output2DArray .Cells(2, 1), aData
.Columns.AutoFit
.Rows.AutoFit
End With
MsgBox "Completed"
End Sub
Sub OutputArray(oDstRng As Range, aCells As Variant)
With oDstRng
.Parent.Select
With .Resize(1, UBound(aCells) - LBound(aCells) + 1)
.NumberFormat = "#"
.Value = aCells
End With
End With
End Sub
Sub Output2DArray(oDstRng As Range, aCells As Variant)
With oDstRng
.Parent.Select
With .Resize( _
UBound(aCells, 1) - LBound(aCells, 1) + 1, _
UBound(aCells, 2) - LBound(aCells, 2) + 1)
.NumberFormat = "#"
.Value = aCells
End With
End With
End Sub
Function ReadTextFile(sPath, lFormat)
' lFormat -2 - System default, -1 - Unicode, 0 - ASCII
With CreateObject("Scripting.FileSystemObject").OpenTextFile(sPath, 1, False, lFormat)
ReadTextFile = ""
If Not .AtEndOfStream Then ReadTextFile = .ReadAll
.Close
End With
End Function
The output for the sample you provided is as follows:
BTW, the similar approach applied in other answers.
cannot execute something from variable vbscript
the data of C:\highlight2.txt is :
"document.all.status1.innerText = 'component failure'"
<script>
set oFile=oFSO.OpenTextFile("C:\highlight2.txt",1)
text=oFile.ReadAll
oFile.Close
arrLines = Split(text, vbCrLf)
dim cmds
For Each strLine in arrLines
if strLine = "" Then
else
strLine
end if
next
</script>
<input value="component check progress" type="text" id="Status1" >
i need to change input field from text, but its not work, input text id was variable. thanks, the help i really appreciate it.
If you have a string containing code to execute, you need to execute it:
>> For Each s In Split("WScript.Echo 1|WScript.Echo 2", "|")
>> WScript.Echo "Statement:", s
>> Execute s
>> On Error Resume Next
>> s
>> WScript.Echo Err.Description
>> On Error GoTo 0
>> WScript.Echo "-----------"
>> Next
>>
Statement: WScript.Echo 1
1
Type mismatch
-----------
Statement: WScript.Echo 2
2
Type mismatch
-----------
>>
html table in webbrowser (VB)
I'm working on creating a table from an access database. It cycles through the database finding any matches and then displays them in a webbrowser.
Currently I have rows showing but I'd love to do an onclick show the rows below. I'm not sure if it's even possible with this type of layout. Thoughts on a different approach?
Private Sub Populate_HtmlTable(ByRef dt As DataTable)
Dim table As String = "<html>" & vbCrLf & _
"<head>" & vbCrLf & _
"</head>" & vbCrLf & _
"<body > " & vbCrLf & _
"<table>"
Label5.Text = "RESULTS RETURNED : " + dt.Rows.Count.ToString
If dt.Rows.Count = False Then
table += "<tr><td> No Results Returned</td> </tr>"
Else
For i As Integer = 0 To dt.Rows.Count - 1
table += "<tr>"
Dim tCellDataItem As New HtmlTableCell()
Dim tCellIntervention As New HtmlTableCell()
Dim tCellTags As New HtmlTableCell()
Dim tCellPR As New HtmlTableCell()
Dim tCellGrade As New HtmlTableCell()
Dim tCellRR As New HtmlTableCell()
Dim tCellEvidence As New HtmlTableCell()
Dim tCellBibliography As New HtmlTableCell()
'Cell Intervention Title
Dim data_item As String = ""
If Not IsDBNull(dt.Rows(i)("data_item")) Then data_item = "<strong>" + dt.Rows(i)(1).ToString() + "</strong><br>"
tCellDataItem.InnerHtml = data_item
'Cell Intervention
Dim intervention As String = ""
If Not IsDBNull(dt.Rows(i)("intervention")) Then intervention = dt.Rows(i)(3).ToString()
tCellIntervention.InnerHtml = intervention
'Cell Tags
Dim tags As String = ""
If Not IsDBNull(dt.Rows(i)("Tags")) Then tags = dt.Rows(i)(10).ToString()
tCellTags.InnerHtml = tags
'Add Cells to Rows and then add Rows to table
table += "<td valign=""top"">" + tCellDataItem.InnerHtml + "</td>"
'table += "</tr>"
'1st Drop Down'
'Interventions
//IF THEY CLICK HERE
table += "<tr><td style=""border:solid; border-bottom-width:2px;""> Intervention Description</td> </tr>"
//DISPLAY THESE ROWS
table += "<tr><td>" + tCellIntervention.InnerHtml + "</td></tr>"
table += "<tr><td> </td></tr>"
table += "<tr><td><strong>Tags: </strong>" + tCellTags.InnerHtml + "</td></tr>"
table += "<tr><td> </td></tr>"
//MORE Info cut out similar to above.
Next
End If
table += "</table></body></html>"
My.Computer.FileSystem.DeleteFile(Application.StartupPath + "\site.html")
My.Computer.FileSystem.WriteAllText(Application.StartupPath + "\site.html", table, True)
WebBrowser1.Navigate(Application.StartupPath + "\site.html")
Retrieve JSON from flash program in IE embed with Autoit
I am trying to retrieve a JSON that is sent from the flash program each time I load it. Using Charles I am able to get the JSON data - application/json; charset=utf8 POST method - from the website however I would like Autoit to capture the JSON data and paste it into a text file on my desktop. Basically, whenever I press a button on the flash program, I would like Autoit to parse the JSON data.
Another way is making a proxy in pure Autoit
#Region ;**** Directives created by AutoIt3Wrapper_GUI ****
#AutoIt3Wrapper_outfile=proxy.exe
#AutoIt3Wrapper_Compression=4
#EndRegion ;**** Directives created by AutoIt3Wrapper_GUI ****
TCPStartup()
#include <GUIConstantsEx.au3>
#include <EditConstants.au3>
#include <GUIEdit.au3>
#Include <Array.au3>
#Include <File.au3>
#include <WindowsConstants.au3>
Opt("GUIOnEventMode" , 1)
Opt("TrayAutoPause",0)
Opt("TrayMenuMode",3)
Opt("TrayOnEventMode",1)
Global $ini = #ScriptDir & "\config.ini"
Global $mainarray[30][10]
Global $proxysocket , $proxysocketssl
Global $GUISHOW = 1
$mainarray[0][0] = "Hostport"
$mainarray[0][1] = "Clientsocket"
$mainarray[0][2] = "Hostsocket"
$mainarray[0][3] = "Request"
$mainarray[0][4] = "Hostname"
$mainarray[0][5] = "Timerhandle connection"
$mainarray[0][6] = "Blocked"
$mainarray[0][7] = "State"
$mainarray[0][8] = "connection type"
$mainarray[0][9] = "req count"
Global $gui = GUICreate("ProxyServer v0.2",700,700)
$DEBUG=GUICtrlCreateEdit("" , 5 , 30 , 500 ,670,BitOr($GUI_SS_DEFAULT_EDIT,$ES_READONLY))
GUICtrlSetLimit(-1 , 2000000000000000)
Global $button_debug_clear = GUICtrlCreateButton("Clear",5,5,90,20)
GUICtrlSetOnEvent($button_debug_clear,"_debug_clear")
GUICtrlCreateLabel("Listening IP:",515,40,70,20)
GUICtrlCreateLabel("Port HTTP:",515,60,70,20)
GUICtrlCreateLabel("Port HTTPS:",515,80,70,20)
Global $input_proxyip = GUICtrlCreateInput("",590, 40,100,20)
Global $input_proxyport = GUICtrlCreateInput("",590,60,60,20)
Global $input_proxyportssl = GUICtrlCreateInput("",590,80,60,20)
Global $button_proxy_save = GUICtrlCreateButton("Save and Restart",515,140,180,20)
GUICtrlSetOnEvent($button_proxy_save,"_mainsocket_save")
Global $checkbox_debug = GUICtrlCreateCheckbox("Debugmode", 515 , 240, 120, 20)
Global $checkbox_debug_save = GUICtrlCreateCheckbox("Save Debug to file", 515 , 260, 120, 20)
Global $checkbox_debug_content = GUICtrlCreateCheckbox("Show traffic content", 515 , 280, 120, 20)
Global $button_debug_content = GUICtrlCreateButton("Binary to String",515,320,120,19)
GUICtrlSetOnEvent($button_debug_content,"_debug_binary")
Global $button_debug_array = GUICtrlCreateButton("show mainarray",515,340,120,19)
GUICtrlSetOnEvent(-1,"_show_array")
Global $tray_showgui = TrayCreateItem("Show gui")
TrayItemSetOnEvent($tray_showgui,"_gui_show")
GUISetOnEvent($GUI_EVENT_CLOSE,"_quit")
GUISetState(#SW_SHOW,$gui)
_mainsocket_create()
While 1
$newclientsock = TCPAccept($proxysocket)
If $newclientsock <> -1 Then
_save("] new HTTP clientconnection :" &_SocketToIP($newclientsock) &#CRLF)
_clientconnection_to_mainarray($newclientsock,80,"HTTP")
EndIf
$newclientsockssl = TCPAccept($proxysocketssl)
If $newclientsockssl <> -1 Then
_save("] new HTTPS clientconnection :" &_SocketToIP($newclientsockssl) &#CRLF)
_clientconnection_to_mainarray($newclientsockssl,443,"HTTPS","start")
EndIf
;--Recieving Req from Client
For $i = 1 To UBound($mainarray) -1
If $mainarray[$i][1] <> "" Then
$request = TCPRecv($mainarray[$i][1],100000)
If #error Then
_save("] Client " & $i & " closed connection after " & Floor(TimerDiff($mainarray[$i][5])) & " ms" & #CRLF)
_mainarray_deleteclient($i)
EndIf
If $request <> "" Then
_save("] Client " & $i & " requested" & #CRLF & #CRLF & $request & #CRLF)
$mainarray[$i][9] += 1
$mainarray[$i][3] = $request
If GUICtrlRead($checkbox_debug_content) = 1 Then _save($request & #CRLF)
EndIf
EndIf
Next
;--connecting and sending Req to Host
For $i = 1 To UBound($mainarray) -1
If $mainarray[$i][3] <> "" Then
If $mainarray[$i][2] = "" Then
$forward = _Get_Address($mainarray[$i][3])
_save("]" & $i &" Got Host Address : " & $forward & #CRLF)
$mainarray[$i][6] = 0
$mainarray[$i][4] = $forward
If $forward = "0" Then
_Send_Response($mainarray[$i][1],400)
_save("]" & $i &" Host is 0 , Error 400" & #CRLF)
Else
$serverip = TCPNameToIP($forward)
$serversock = TCPConnect($serverip,$mainarray[$i][0])
If $serversock <> -1 Then
_save("]" & $i &" Connected to Host: " & $forward & #CRLF)
$mainarray[$i][2] = $serversock
Else
_save("]" & $i &" Not Connected to Host: " & $forward & #CRLF)
_Send_Response($mainarray[$i][1],400)
_mainarray_deleteclient($i)
EndIf
EndIf
Else
$forward = _Get_Address($mainarray[$i][3])
If $forward <> $mainarray[$i][4] Then
_save("]" & $i &" Host Address changed from: " & $mainarray[$i][4] & " to: " & $forward & #CRLF)
$mainarray[$i][4] = $forward
TCPCloseSocket($mainarray[$i][2])
$mainarray[$i][2] = ""
EndIf
EndIf
If $mainarray[$i][2] <> "" Then
$prevlen = StringLen($mainarray[$i][3])
$mainarray[$i][3] = _request_modify($mainarray[$i][3],$mainarray[$i][4])
If $mainarray[$i][7] = "" Then
;$mainarray[$i][3] = _request_modify($mainarray[$i][3],$mainarray[$i][4])
TCPSend($mainarray[$i][2] , $mainarray[$i][3])
If Not #error Then
_save("]" & $i &" Sending HTTP to Host " & $mainarray[$i][4] & " successfull prevlen:" & $prevlen & " now:" & StringLen($mainarray[$i][3]) & #CRLF)
$mainarray[$i][3] = ""
Else
_save("]" & $i &" Error Sending HTTP to Host " & #CRLF)
EndIf
EndIf
EndIf
EndIf
Next
;--Waiting for Response from Host and Sending to client
For $i = 1 To UBound($mainarray) -1
If $mainarray[$i][2] <> "" Then
$serverresponse = TCPRecv($mainarray[$i][2],400000,1)
If #error Then
_mainarray_hostkillclient($i)
EndIf
If $serverresponse <> Binary("") Then
If $mainarray[$i][6] = 0 Then
_save("]" & $i &" Got Host response" & #CRLF)
If $mainarray[$i][1] <> "" And $mainarray[$i][7] = "" Then
TCPSend($mainarray[$i][1],$serverresponse)
If Not #error Then
_save("]" & $i &" Sent data to Client " & #CRLF)
If GUICtrlRead($checkbox_debug_content) = 1 Then _save(BinaryToString($serverresponse) & #CRLF)
EndIf
EndIf
ElseIf $mainarray[$i][6] = 1 Then
TCPSend($mainarray[$i][1],"HTTP/1.1 " & "403")
_mainarray_hostkillclient($i)
EndIf
EndIf
EndIf
Next
;---only for HTTPS
For $i = 1 To UBound($mainarray) -1
If $mainarray[$i][1] <> "" And $mainarray[$i][3] <> "" And $mainarray[$i][8] = "HTTPS" And $mainarray[$i][7] = "start" Then
_Send_Response($mainarray[$i][1],200) ;,$data="")
$mainarray[$i][3] = ""
$mainarray[$i][7] = ""
EndIf
Next
WEnd
Func _show_array()
_ArrayDisplay($mainarray)
EndFunc
Func _mainsocket_save()
IniWrite($ini,"SYSTEM","PROXYPORT",GUICtrlRead($input_proxyport))
IniWrite($ini,"SYSTEM","PROXYIP",GUICtrlRead($input_proxyip))
IniWrite($ini,"SYSTEM","PROXYPORTSSL",GUICtrlRead($input_proxyportssl))
_mainsocket_create()
EndFunc
Func _mainsocket_create()
TCPShutdown()
TCPStartup()
$IP = IniRead($ini,"SYSTEM","PROXYIP","127.0.0.1")
$PORT = IniRead($ini,"SYSTEM","PROXYPORT","8080")
$PORTSSL = IniRead($ini,"SYSTEM","PROXYPORTSSL","8043")
GUICtrlSetData($input_proxyip, $IP)
GUICtrlSetData($input_proxyport,$PORT)
GUICtrlSetData($input_proxyportssl,$PORTSSL)
$proxysocket = TCPListen($IP,$PORT)
If #error Then
_GUICtrlEdit_AppendText($DEBUG , "] Error HTTP Proxy couldn't bind socket on IP :" & $IP & " Port :" & $PORT & #CRLF)
Else
_GUICtrlEdit_AppendText($DEBUG , "] HTTP Proxy listening on IP :" & $IP & " Port :" & $PORT & #CRLF)
EndIf
$proxysocketssl = TCPListen($IP,$PORTSSL)
If #error Then
_GUICtrlEdit_AppendText($DEBUG , "] Error HTTPS Proxy couldn't bind socket on IP :" & $IP & " Port :" & $PORTSSL & #CRLF)
Else
_GUICtrlEdit_AppendText($DEBUG , "] HTTPS Proxy listening on IP :" & $IP & " Port :" & $PORTSSL & #CRLF)
EndIf
EndFunc
Func _Get_Address($text)
If IsBinary($text) Then
$text = BinaryToString($text)
EndIf
$serversock=StringSplit($text , #CRLF,1)
For $i=1 To $serversock[0]
If StringLeft($serversock[$i],6)="Host: " Then
Return StringTrimLeft($serversock[$i],6)
EndIf
Next
Return 0
EndFunc
Func _clientconnection_to_mainarray($sock,$port = 80,$type = "HTTP",$state = "")
For $i = 1 To UBound($mainarray) -1
If $mainarray[$i][1] = "" And $mainarray[$i][2] = "" Then
$mainarray[$i][1] = $sock
$mainarray[$i][0] = $port
$mainarray[$i][5] = TimerInit()
$mainarray[$i][7] = $state
$mainarray[$i][8] = $type
_save("] Added new client to mainarray , pos: " & $i & #CRLF)
If $i + 5 > UBound($mainarray) Then ReDim $mainarray[UBound($mainarray)+5][10]
Return
EndIf
Next
EndFunc
Func _mainarray_deleteclient($line)
TCPCloseSocket($mainarray[$line][1])
$mainarray[$line][0] = ""
$mainarray[$line][1] = ""
$mainarray[$line][3] = ""
$mainarray[$line][4] = ""
$mainarray[$line][5] = ""
$mainarray[$line][6] = ""
$mainarray[$line][7] = ""
$mainarray[$line][8] = ""
$mainarray[$line][9] = ""
If $mainarray[$line][2]<> "" Then
TCPCloseSocket($mainarray[$line][2])
$mainarray[$line][2] = ""
EndIf
EndFunc
Func _mainarray_hostkillclient($line)
_save("]" & $line &" Connection Closed by Host after " & Floor(TimerDiff($mainarray[$line][5])) & " ms" & #CRLF)
$mainarray[$line][2] = ""
$mainarray[$line][4] = ""
$mainarray[$line][5] = ""
If $mainarray[$line][1]<> "" Then
TCPCloseSocket($mainarray[$line][1])
_mainarray_deleteclient($line)
EndIf
EndFunc
Func _Send_Response($browsersock,$code,$data="")
If $data="" Then
$data=#CRLF & #CRLF
Else
$data=#CRLF & $data & #CRLF & #CRLF
EndIf
TCPSend($browsersock , "HTTP/1.0 " & $code & " Message" & $data)
EndFunc
Func _quit()
TCPShutdown()
Exit
EndFunc
Func _gui_show()
If $GUISHOW = 0 Then
Local $pw = InputBox("Enter Password","Enter Password","","*",150,130)
If Not #error Then
If $pw = "1234" Then
GUISetState(#SW_SHOW)
$GUISHOW = 1
Return
EndIf
EndIf
ElseIf $GUISHOW = 1 Then
GUISetState(#SW_HIDE)
$GUISHOW = 0
Return
EndIf
EndFunc
Func _save($text)
If GUICtrlRead($checkbox_debug_save) = 1 Then
$file = FileOpen(#ScriptDir & "\log\" & #Year & #MON & #MDAY & "-log.txt",9)
FileWrite ($file,$text)
FileClose($file)
Endif
If GUICtrlRead($checkbox_debug) = 1 Then _GUICtrlEdit_AppendText($DEBUG , $text)
Endfunc
Func _SocketToIP($SHOCKET)
Local $sockaddr, $aRet
$sockaddr = DllStructCreate("short;ushort;uint;char[8]")
$aRet = DllCall("Ws2_32.dll", "int", "getpeername", "int", $SHOCKET, _
"ptr", DllStructGetPtr($sockaddr), "int*", DllStructGetSize($sockaddr))
If Not #error And $aRet[0] = 0 Then
$aRet = DllCall("Ws2_32.dll", "str", "inet_ntoa", "int", DllStructGetData($sockaddr, 3))
If Not #error Then $aRet = $aRet[0]
Else
$aRet = 0
EndIf
$sockaddr = 0
Return $aRet
EndFunc ;==>SocketToIP
Func _debug_binary()
Local $aSel = _GUICtrlEdit_GetSel($DEBUG)
Local $text = StringMid(GUICtrlRead($DEBUG),$aSel[0]+1,$aSel[1]-$aSel[0])
If $text <> "" Then
Else
$text = InputBox("Binary to String","Enter Binary Data")
EndIf
If StringLower(StringLeft($text,2)) <> "0x" Then $text = "0x" & $text
$tempfile = FileOpen(#ScriptDir & "\temp.txt",2)
FileWrite($tempfile,BinaryToString($text))
FileClose($tempfile)
ShellExecute(#ScriptDir & "\temp.txt")
EndFunc
Func _debug_clear()
GUICtrlSetData($DEBUG,"")
EndFunc
Func _request_modify($req,$host)
Local $encoding = "Accept-Encoding: identity" ;deflate, gzip, compress,
Local $reqsplit
Local $modified_method = 0 , $modified_connection = 0 , $modified_encoding = 0
If $req <> "" And Not IsBinary($req) Then
$reqsplit = StringSplit($req,#CRLF,1)
If IsArray($reqsplit) Then
For $i = 1 to $reqsplit[0] - 1
_save("] modifying :" & $i & " " & $reqsplit[$i])
If StringLeft($reqsplit[$i],3) = "GET" Or StringLeft($reqsplit[$i],4) = "POST" Or StringLeft($reqsplit[$i],7) = "CONNECT" And $modified_method = 0 Then
$reqsplit[$i] = StringReplace($reqsplit[$i],$host,"")
$reqsplit[$i] = StringReplace($reqsplit[$i],"http://","")
$reqsplit[$i] = StringReplace($reqsplit[$i],":443","")
$modified_method = 1
EndIf
If StringInStr(Stringlower($reqsplit[$i]),"proxy-connection: keep-alive") And $modified_connection = 0 Then
$reqsplit[$i] = "Connection: keep-alive"
$modified_connection = 1
EndIf
If StringInStr(Stringlower($reqsplit[$i]),"accept-encoding") And $modified_encoding = 0 Then
$reqsplit[$i] = $encoding
$modified_encoding = 1
EndIf
_save(" -> to :" & $reqsplit[$i] & #CRLF)
Next
$req = _ArrayToString($reqsplit, #CRLF , 1 , Ubound($reqsplit)-1)
EndIf
If GUICtrlRead($checkbox_debug_content) = 1 Then
_save("] Request modified to:" & #CRLF)
_save($req &#CRLF)
EndIf
EndIf
Return $req
EndFunc
What you need is a WinPcap Autoit3 UDF Look at the Example(3): Saving http traffic to a pcap file for 10s...
VBA: Creating substrings out of JSON and reformatting into columns
I have information from a Facebook FQL Query in the form of JSON and pasted it into Excel. Here's a part of the result:
"data": [
{
"name": "Hilton Head Island - TravelTell",
"location": {
"street": "7 Office Way, Suite 215",
"city": "Hilton Head Island",
"state": "SC"
},
"fan_count": 143234,
"talking_about_count": 18234,
"were_here_count": 4196
},
{
"name": "Hilton Hawaiian Village Waikiki Beach Resort",
"location": {
"street": "2005 Kalia Road",
"city": "Honolulu",
"state": "HI"
},
"fan_count": 34072,
"talking_about_count": 4877,
"were_here_count": 229999
},
{
"name": "Hilton New York",
"location": {
"street": "1335 Avenue of the Americas",
"city": "New York",
"state": "NY"
},
"fan_count": 12885,
"talking_about_count": 969,
"were_here_count": 72206
},
I'm trying to use substrings to parse the data and then create columns on another worksheet using "name, street, city, state, fan_count, etc." as the column headers. I'm trying out code to do this for just "name:" right now but there's an error when it hits the line with documentText = myRange.Text . I can't figure out what the error is.
Another problem is that the strings contain quotations. For example, I want the SecondTerm to be ", but I get errors when I try to have it equal "","
Sub Substring_Test()
Dim nameFirstTerm As String
Dim nameSecondTerm As String
Dim myRange As Range
Dim documentText As String
Dim startPos As Long 'Stores the starting position of firstTerm
Dim stopPos As Long 'Stores the starting position of secondTerm based on first term's location
Dim nextPosition As Long 'The next position to search for the firstTerm
nextPosition = 1
'First and Second terms as defined by your example. Obviously, this will have to be more dynamic
'if you want to parse more than justpatientFirstname.
firstTerm = "name"": """
secondTerm = ""","""
'Get all the document text and store it in a variable.
Set myRange = Sheets("Sheet1").UsedRange
'Maximum limit of a string is 2 billion characters.
'So, hopefully your document is not bigger than that. However, expect declining performance based on how big doucment is
documentText = myRange.Text
'Loop documentText till you can't find any more matching "terms"
Do Until nextPosition = 0
startPos = InStr(nextPosition, documentText, firstTerm, vbTextCompare)
stopPos = InStr(startPos, documentText, secondTerm, vbTextCompare)
Debug.Print Mid$(documentText, startPos + Len(firstTerm), stopPos - startPos - Len(secondTerm))
nextPosition = InStr(stopPos, documentText, firstTerm, vbTextCompare)
Loop
Sheets("Sheet2").Range("A1").Value = documentText
End Sub
Sub Tester()
Dim json As String
Dim sc As Object
Dim o, loc, x, num
Set sc = CreateObject("scriptcontrol")
sc.Language = "JScript"
json = ActiveSheet.Range("a1").Value
'Debug.Print json
sc.Eval "var obj=(" & json & ")" 'evaluate the json response
'Add some accessor functions...
' get count of records returned
sc.AddCode "function getCount(){return obj.data.length;}"
' return a specific record (with some properties renamed)
sc.AddCode "function getItem(i){var o=obj.data[i];" & vbLf & _
"return {nm:o.name,loc:o.location," & vbLf & _
"f:o.fan_count,ta:o.talking_about_count," & vbLf & _
"wh:o.were_here_count};}"
num = sc.Run("getCount")
Debug.Print "#Items", num
For x = 0 To num - 1
Debug.Print ""
Set o = sc.Run("getItem", x)
Debug.Print "Name", o.nm
Debug.Print "Street", o.loc.street
Debug.Print "City", o.loc.city
Debug.Print "Street", o.loc.street
Debug.Print "Fans", o.f
Debug.Print "talking_about", o.ta
Debug.Print "were_here", o.wh
Next x
End Sub
Note: the javascript getItem function dosn't return a record directly, but wraps the data so that some of the JSON-drived property names are altered (specifically "name" and "location"). VBA seems to have a problem dealing with accessing properties on objects passed from javascript if the property name resembles a "regular" property like Name (or Location).
This should work although you may need to change some of the sheet names
Sub Test()
Dim vData() As Variant
Dim vHeaders As Variant
Dim vCell As Variant
Dim i As Long
vHeaders = Array("Name", "Street", "City", "State", "Fan Count", "Talking About Count", "Were Here Count")
i = 1
Do While i <= ActiveSheet.UsedRange.Rows.Count
If InStr(Cells(i, 1).Text, "{") Or _
InStr(Cells(i, 1).Text, "}") Or _
Cells(i, 1).Text = """data"": [" Or _
Cells(i, 1).Text = "" Then
Rows(i).Delete
Else
Cells(i, 1).Value = Replace(Cells(i, 1).Text, """", "")
Cells(i, 1).Value = Replace(Cells(i, 1).Text, ",", "")
Cells(i, 1).Value = WorksheetFunction.Trim(Cells(i, 1).Text)
i = i + 1
End If
Loop
i = 0
For Each vCell In Range(Cells(1, 1), Cells(ActiveSheet.UsedRange.Rows.Count, 1))
If InStr(vCell.Text, "name:") Then
i = i + 1
ReDim Preserve vData(1 To 7, 1 To i)
End If
If InStr(vCell.Text, "name") Then
vData(1, i) = Right(vCell.Text, Len(vCell.Text) - InStr(1, vCell.Text, ":"))
End If
If InStr(vCell.Text, "street") Then
vData(2, i) = Right(vCell.Text, Len(vCell.Text) - InStr(1, vCell.Text, ":"))
End If
If InStr(vCell.Text, "city") Then
vData(3, i) = Right(vCell.Text, Len(vCell.Text) - InStr(1, vCell.Text, ":"))
End If
If InStr(vCell.Text, "state") Then
vData(4, i) = Right(vCell.Text, Len(vCell.Text) - InStr(1, vCell.Text, ":"))
End If
If InStr(vCell.Text, "fan_count") Then
vData(5, i) = Right(vCell.Text, Len(vCell.Text) - InStr(1, vCell.Text, ":"))
End If
If InStr(vCell.Text, "talking_about_count") Then
vData(6, i) = Right(vCell.Text, Len(vCell.Text) - InStr(1, vCell.Text, ":"))
End If
If InStr(vCell.Text, "were_here_count") Then
vData(7, i) = Right(vCell.Text, Len(vCell.Text) - InStr(1, vCell.Text, ":"))
End If
Next
'Cells.Delete
Sheets("Sheet2").Select
Range(Cells(1, 1), Cells(UBound(vData, 2), UBound(vData))).Value = WorksheetFunction.Transpose(vData)
Rows(1).EntireRow.Insert
Range(Cells(1, 1), Cells(1, UBound(vHeaders) + 1)).Value = vHeaders
End Sub
I have no clue about the 1st part (not familiar with JSON at all), but regarding the 2nd one - try the following lines: firstTerm = Chr(34) & "name: " & Chr(34) secondTerm = Chr(34) & "," Or simply - use Chr(34) for every double quote you want.