-
Notifications
You must be signed in to change notification settings - Fork 13
/
Form1.vb
3623 lines (3446 loc) · 225 KB
/
Form1.vb
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
Imports Newtonsoft.Json.Linq
Imports Newtonsoft.Json
Imports Newtonsoft.Json.Bson
Imports Newtonsoft.Json.Serialization
Imports Newtonsoft.Json.Schema
Imports Newtonsoft.Json.Converters
Imports System.Data.SqlClient
Imports System.Runtime.InteropServices
Imports System.ComponentModel
Imports System.Net
Imports System.Text
Imports System.Environment
Imports System.IO
Imports System.Diagnostics
Imports System.Data.SqlServerCe
Imports System.Drawing.Drawing2D
Imports System.Configuration
Imports System.Security.Cryptography
Imports Masterchest.mlib
Imports Org.BouncyCastle.Math.EC
Imports System.Globalization
Public Class Form1
Public startup As Boolean = True
Public asyncjump As Boolean = True
Const WM_NCLBUTTONDOWN As Integer = &HA1
Const HT_CAPTION As Integer = &H2
Public mlib As New Masterchest.mlib
'////////////////////////
'///HANDLE FORM FUNCTIONS
'////////////////////////
<DllImportAttribute("user32.dll")> Public Shared Function SendMessage(ByVal hWnd As IntPtr, ByVal Msg As Integer, ByVal wParam As Integer, ByVal lParam As Integer) As Integer
End Function
<DllImportAttribute("user32.dll")> Public Shared Function ReleaseCapture() As Boolean
End Function
Private Sub Form1_FormClosing(ByVal sender As Object, ByVal e As System.Windows.Forms.FormClosingEventArgs) Handles Me.FormClosing
End Sub
Private Sub Form1_MouseDown(ByVal sender As Object, ByVal e As MouseEventArgs) Handles MyBase.MouseDown, RectangleShape1.MouseDown, psetup.MouseDown, pwelcome.MouseDown, pbalances.MouseDown, paddresses.MouseDown, pdebug.MouseDown, poverview.MouseDown, psend.MouseDown, psettings.MouseDown, pproperties.MouseDown
If e.Button = MouseButtons.Left Then
tryunfocusinputs()
dgvaddresses.CurrentCell = Nothing
dgvaddresses.ClearSelection()
dgvhistory.CurrentCell = Nothing
dgvhistory.ClearSelection()
dgvselloffer.CurrentCell = Nothing
dgvselloffer.ClearSelection()
dgvopenorders.CurrentCell = Nothing
dgvopenorders.ClearSelection()
ReleaseCapture()
SendMessage(Handle, WM_NCLBUTTONDOWN, HT_CAPTION, 0)
End If
End Sub
Private Sub bclose_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles bclose.Click
Me.WindowState = FormWindowState.Minimized
Me.Visible = False
nfi.Visible = True
nfi.BalloonTipTitle = "Masterchest Wallet Background Mode"
nfi.BalloonTipText = "To return to the wallet, simply double-click the icon in your system tray. If you wish to completely exit the wallet, please right click on the system tray icon and choose 'Exit'."
nfi.BalloonTipIcon = ToolTipIcon.Info
nfi.ShowBalloonTip(30000)
End Sub
Private Sub bmin_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles bmin.Click
Me.WindowState = FormWindowState.Minimized
End Sub
Private Sub mnurestore_click(ByVal sender As System.Object, ByVal e As System.EventArgs)
nfi.Visible = False
Me.Visible = True
Me.WindowState = FormWindowState.Normal
End Sub
Private Sub mnuexit_click(ByVal sender As System.Object, ByVal e As System.EventArgs)
nfi.Visible = False
Application.Exit()
End Sub
'//////////////
'////INITIALIZE
'//////////////
Private Sub Form1_Load(ByVal sender As Object, ByVal e As System.EventArgs) Handles Me.Load
'context icon
Dim icnmnu As New ContextMenuStrip
Dim mnurestore As New ToolStripMenuItem("&Restore")
AddHandler mnurestore.Click, AddressOf mnurestore_click
icnmnu.Items.AddRange(New ToolStripItem() {mnurestore})
Dim mnuexit As New ToolStripMenuItem("E&xit")
AddHandler mnuexit.Click, AddressOf mnuexit_click
icnmnu.Items.AddRange(New ToolStripItem() {mnuexit})
nfi.ContextMenuStrip = icnmnu
'declare globalization to make sure we use a . for decimal only
Dim customCulture As System.Globalization.CultureInfo = System.Threading.Thread.CurrentThread.CurrentCulture.Clone()
customCulture.NumberFormat.NumberDecimalSeparator = "."
System.Threading.Thread.CurrentThread.CurrentCulture = customCulture
System.Threading.Thread.CurrentThread.CurrentUICulture = customCulture
'declare current currency for exchange
dexcur = "MSC"
lnkdexcurrency.Text = "Mastercoin"
'deprecated
MsgBox("DEPRECATED SOFTWARE - PLEASE READ" & vbCrLf & "===========================" & vbCrLf & vbCrLf & "Masterchest Wallet software is DEPRECATED." & vbCrLf & vbCrLf & "All development has recently been consolidated on the upcoming Master Core platform and Masterchest Wallet will receive no further updates. This means that this software will *NOT* be able to display accurate information as new features are made live on the Master Protocol, and transactions sent from this wallet may be declared invalid." & vbCrLf & vbCrLf & "This software is DEPRECATED. Please check mastercoin.org for information about supported software.")
'disclaimer
MsgBox("DISCLAIMER - PLEASE READ - TEST ONLY: " & vbCrLf & "============================" & vbCrLf & vbCrLf & "This software is EXPERIMENTAL software for TESTING only." & vbCrLf & vbCrLf & "ALL USE OF THIS SOFTWARE IS ENTIRELY AT YOUR OWN RISK." & vbCrLf & vbCrLf & "The protocol and transaction processing rules for Mastercoin are still under active development and are subject to change in future." & vbCrLf & vbCrLf & "DO NOT USE IT WITH A LARGE AMOUNT OF MASTERCOINS AND/OR BITCOINS. IT IS ENTIRELY POSSIBLE YOU MAY LOSE ALL YOUR COINS. INFORMATION DISPLAYED MAY BE INCORRECT. MASTERCHEST OFFERS ABSOLUTELY NO GUARANTEES OF ANY KIND." & vbCrLf & vbCrLf & "A fraction of a bitcoin and a fraction of a mastercoin are the suggested testing amounts. Preferably use a fresh bitcoin wallet.dat." & vbCrLf & vbCrLf & "DO *NOT* USE THIS SOFTWARE WITH WALLETS CONTAINING, OR TRANSACT WITH, SIGNIFICANT AMOUNTS - IT IS FOR TESTING ONLY." & vbCrLf & vbCrLf & "This software is provided open-source at no cost. You are responsible for knowing the law in your country and determining if your use of this software contravenes any local laws.")
poversync.Image = My.Resources.gif
loversync.Text = "Syncronizing..."
bback.Visible = False
hidelabels()
initialize()
'are we configured?
'setup bitcoin connection
txtrpcserver.Text = "Not configured."
txtrpcport.Text = "Not configured."
txtrpcuser.Text = "Not configured."
txtrpcpassword.Text = "Not configured."
Try
Dim btcconf As String = GetFolderPath(SpecialFolder.ApplicationData)
btcconf = btcconf & "\Bitcoin\bitcoin.conf"
If System.IO.File.Exists(btcconf) = True Then
Dim objreader As New System.IO.StreamReader(btcconf)
Dim line As String
'set defaults
bitcoin_con.bitcoinrpcserver = "127.0.0.1"
bitcoin_con.bitcoinrpcport = 8332
Dim txenabled As Boolean = False
Dim rpcenabled As Boolean = False
Do
line = objreader.ReadLine()
If Len(line) > 7 Then
Select Case line.ToLower.Substring(0, 7)
Case "rpcport"
bitcoin_con.bitcoinrpcport = Val(line.Substring(8, Len(line) - 8))
txtrpcport.Text = bitcoin_con.bitcoinrpcport.ToString
Case "rpcuser"
bitcoin_con.bitcoinrpcuser = line.Substring(8, Len(line) - 8)
txtrpcuser.Text = bitcoin_con.bitcoinrpcuser
Case "rpcpass"
bitcoin_con.bitcoinrpcpassword = line.Substring(12, Len(line) - 12)
txtrpcpassword.Text = "********************"
Case "txindex"
If line.ToLower.Substring(0, 9) = "txindex=1" Then txenabled = True
Case "server="
If line.ToLower.Substring(0, 8) = "server=1" Then rpcenabled = True
Case "gettingstarted#"
'gettingstardscreen
psetup.Visible = True
Exit Sub
End Select
End If
Loop Until line Is Nothing
objreader.Close()
If rpcenabled = False Then
MsgBox("BITCOIN AUTO CONFIGURATION" & vbCrLf & vbCrLf & "Auto-detection has determined your bitcoind/qt configuration does not have the RPC server enabled." & vbCrLf & vbCrLf & "Please add server=1 to bitcoin.conf and restart bitcoind/qt." & vbCrLf & vbCrLf & "Will now exit.")
Application.Exit()
End If
If txenabled = False Then
MsgBox("BITCOIN AUTO CONFIGURATION" & vbCrLf & vbCrLf & "Auto-detection has determined your bitcoind/qt configuration does not have the transaction index enabled." & vbCrLf & vbCrLf & "Please add txindex=1 to bitcoin.conf and restart bitcoind/qt with the -reindex flag to enable the transaction index." & vbCrLf & vbCrLf & "Will now exit.")
Application.Exit()
End If
Else
'couldn't auto-detect bitcoin settings, looking at manual config
Try
Dim FINAME As String = Application.StartupPath & "\wallet.cfg"
If System.IO.File.Exists(FINAME) = True Then
Dim objreader As New System.IO.StreamReader(FINAME)
Dim line As String
Do
line = objreader.ReadLine()
If Len(line) > 14 Then
Select Case line.ToLower.Substring(0, 15)
Case "bitcoinrpcserv="
bitcoin_con.bitcoinrpcserver = line.Substring(15, Len(line) - 15)
txtrpcserver.Text = bitcoin_con.bitcoinrpcserver
Case "bitcoinrpcport="
bitcoin_con.bitcoinrpcport = Val(line.Substring(15, Len(line) - 15))
txtrpcport.Text = bitcoin_con.bitcoinrpcport.ToString
Case "bitcoinrpcuser="
bitcoin_con.bitcoinrpcuser = line.Substring(15, Len(line) - 15)
txtrpcuser.Text = bitcoin_con.bitcoinrpcuser
Case "bitcoinrpcpass="
bitcoin_con.bitcoinrpcpassword = line.Substring(15, Len(line) - 15)
txtrpcpassword.Text = "********************"
End Select
End If
Loop Until line Is Nothing
objreader.Close()
End If
Catch ex As Exception
MsgBox("Exception reading configuration : " & ex.Message)
Application.Exit()
End Try
End If
Catch ex As Exception
MsgBox("Exception during configuration : " & ex.Message)
Application.Exit()
End Try
'show welcome panel
pwelcome.Visible = True
'Me.ActiveControl = txtwalpass
lwelstartup.Text = "Startup: Initializing..."
End Sub
Private Sub updateui()
Me.Refresh()
Application.DoEvents()
End Sub
Private Sub teststartup()
'build 0021 drastically shrunk most of the startup delays, we no longer need to wait for anything to catch up etc
'check we have configuration info
If bitcoin_con.bitcoinrpcserver = "" Or bitcoin_con.bitcoinrpcport = 0 Or bitcoin_con.bitcoinrpcuser = "" Or bitcoin_con.bitcoinrpcpassword = "" Then
MsgBox("There was a problem configuring your connection to bitcoind/qt. Both auto detection and manual configuration appear to have failed." & vbCrLf & vbCrLf & "Will now exit.")
Application.Exit()
End If
'test connection to bitcoind
lwelstartup.Text &= vbCrLf & "Startup: Testing bitcoin connection..."
Application.DoEvents()
System.Threading.Thread.Sleep(100)
Application.DoEvents()
Try
Dim checkhash As blockhash = mlib.getblockhash(bitcoin_con, 2)
If checkhash.result.ToString = "000000006a625f06636b8bb6ac7b960a8d03705d1ace08b1a19da3fdcc99ddbd" Then 'we've got a correct response
lwelstartup.Text &= vbCrLf & "Startup: Connection to bitcoin via RPC established and sanity check OK."
Else
'something has gone wrong
lwelstartup.Text &= vbCrLf & "Startup ERROR: Connection to bitcoin RPC seems to be established but responses are not as expected. Aborting startup."
Exit Sub
End If
Catch ex2 As Exception
lwelstartup.Text &= vbCrLf & "Startup ERROR: Exception testing connection to bitcoin via RPC. Aborting startup. E2: " & ex2.Message
MsgBox("ERROR: An exception was raised testing your connection to bitcoin via RPC. Please ensure bitcoind/qt is running. The wallet will now exit.")
Application.Exit()
End Try
Application.DoEvents()
System.Threading.Thread.Sleep(100)
Application.DoEvents()
'test connection to database
lwelstartup.Text &= vbCrLf & "Startup: Testing database connection..."
Application.DoEvents()
System.Threading.Thread.Sleep(100)
Application.DoEvents()
Dim testval As Integer
testval = SQLGetSingleVal("SELECT count(*) FROM information_schema.columns WHERE table_name = 'processedblocks'")
If testval = 99 Then Application.Exit() 'something went wrong
If testval = 3 Then 'sanity check ok
lwelstartup.Text &= vbCrLf & "Startup: Connection to database established and sanity check OK."
Else
'something has gone wrong
lwelstartup.Text &= vbCrLf & "Startup ERROR: Connection to database seems to be established but responses are not as expected. Aborting startup."
Exit Sub
End If
Application.DoEvents()
System.Threading.Thread.Sleep(100)
Application.DoEvents()
'### we have confirmed our connections to resources external to the program ###
'enumarate bitcoin addresses
lwelstartup.Text &= vbCrLf & "Startup: Enumerating wallet addresses..."
Application.DoEvents()
System.Threading.Thread.Sleep(100)
Application.DoEvents()
balubtc = 0
Try
Dim addresses As List(Of btcaddressbal) = mlib.getaddresses(bitcoin_con)
taddresslist.Clear()
For Each address In addresses
taddresslist.Rows.Add(address.address, address.amount, 0, 0)
balubtc = balubtc + address.uamount
Next
dgvaddresses.DataSource = Nothing
dgvaddresses.Refresh()
'load addresslist with taddresslist
addresslist.Clear()
For Each row In taddresslist.Rows
addresslist.Rows.Add(row.item(0), row.item(1), row.item(2), row.item(3))
Next
dgvaddresses.DataSource = addresslist
Dim dgvcolumn As New DataGridViewColumn
dgvcolumn = dgvaddresses.Columns(0)
dgvcolumn.Width = 370
dgvcolumn = dgvaddresses.Columns(1)
'dgvcolumn.DefaultCellStyle.Alignment = DataGridViewContentAlignment.MiddleRight
dgvcolumn.DefaultCellStyle.Format = "########0.00######"
dgvcolumn.Width = 130
dgvcolumn = dgvaddresses.Columns(2)
'dgvcolumn.DefaultCellStyle.Alignment = DataGridViewContentAlignment.MiddleRight
dgvcolumn.DefaultCellStyle.Format = "########0.00######"
dgvcolumn.Width = 130
dgvcolumn = dgvaddresses.Columns(3)
'dgvcolumn.DefaultCellStyle.Alignment = DataGridViewContentAlignment.MiddleRight
dgvcolumn.DefaultCellStyle.Format = "########0.00######" '"########0.00######"
dgvcolumn.Width = 130
If lnkaddsort.Text = "Address Alpha" Then dgvaddresses.Sort(dgvaddresses.Columns(0), System.ComponentModel.ListSortDirection.Ascending)
If lnkaddsort.Text = "BTC Balance" Then dgvaddresses.Sort(dgvaddresses.Columns(1), System.ComponentModel.ListSortDirection.Descending)
If lnkaddsort.Text = "MSC Balance" Then dgvaddresses.Sort(dgvaddresses.Columns(3), System.ComponentModel.ListSortDirection.Descending)
If lnkaddfilter.Text = "No Filter Active" Then addresslist.DefaultView.RowFilter = ""
If lnkaddfilter.Text = "Empty Balances" Then addresslist.DefaultView.RowFilter = "btcamount > 0 or mscamount > 0 or tmscamount > 0"
Catch ex As Exception
MsgBox(ex.Message)
lwelstartup.Text &= vbCrLf & "Startup ERROR: Enumerating addresses did not complete properly. Aborting startup."
Exit Sub
End Try
balbtc = 0
For Each row In taddresslist.Rows
balbtc = balbtc + row.item(1)
Next
startup = False
lwelstartup.Text &= vbCrLf & "Startup: Initialization Complete."
Application.DoEvents()
System.Threading.Thread.Sleep(1000)
Application.DoEvents()
'do some initial setup
showlabels()
bback.Visible = True
txtdebug.Text = "MASTERCHEST WALLET v0.4a"
activateoverview()
lastscreen = "1"
updateui()
Me.Refresh()
Application.DoEvents()
'kick off the background worker thread
If workthread.IsBusy <> True Then
syncicon.Image = My.Resources.gif
syncicon.Visible = True
lsyncing.Visible = True
lsyncing.Text = "Synchronizing..."
workthread.RunWorkerAsync()
End If
End Sub
Private Sub txtsendamount_Enter(ByVal sender As Object, ByVal e As EventArgs) Handles txtsendamount.Enter '## credit dexX7
If lcurdiv.Text = "Divisible currency" Then
If txtsendamount.Text = "0.00000000" Then
txtsendamount.Text = ""
End If
Else
If txtsendamount.Text = "0" Then
txtsendamount.Text = ""
End If
End If
End Sub
Private Sub txtsendamount_Leave(ByVal sender As Object, ByVal e As EventArgs) Handles txtsendamount.Leave '## credit dexX7
If lcurdiv.Text = "Divisible currency" Then
If txtsendamount.Text = "" Then
txtsendamount.Text = "0.00000000"
Else
txtsendamount.Text = Val(txtsendamount.Text).ToString("##########0.00000000")
End If
Else
If txtsendamount.Text = "" Then
txtsendamount.Text = "0"
Else
txtsendamount.Text = Math.Truncate(Val(txtsendamount.Text)).ToString("############0")
End If
End If
End Sub
Private Sub bback_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles bback.MouseUp
Dim lastval
If Len(lastscreen) > 1 Then
lastscreen = lastscreen.Substring(0, Len(lastscreen) - 1)
lastval = lastscreen(lastscreen.Length - 1)
If lastval = "1" Then activateoverview()
If lastval = "2" Then activatecurrencies()
If lastval = "3" Then activatesend()
If lastval = "4" Then activateaddresses()
If lastval = "5" Then activatehistory()
If lastval = "6" Then activateproperties()
If lastval = "7" Then activatedebug()
End If
End Sub
'////////////
'/////BUTTONS
'////////////
Private Sub boverview_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles boverview.Click
If curscreen <> "1" Then
activateoverview()
lastscreen = lastscreen & "1"
End If
End Sub
Private Sub bcurrencies_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles bbalances.Click
If curscreen <> "2" Then
activatecurrencies()
lastscreen = lastscreen & "2"
End If
End Sub
Private Sub bsend_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles bsend.Click
If curscreen <> "3" Then
activatesend()
lastscreen = lastscreen & "3"
End If
End Sub
Private Sub baddresses_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles baddresses.Click
If curscreen <> "4" Then
activateaddresses()
lastscreen = lastscreen & "4"
End If
End Sub
Private Sub bhistory_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles bhistory.Click
If curscreen <> "5" Then
activatehistory()
lastscreen = lastscreen & "5"
End If
End Sub
Private Sub bproperties_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles bproperties.Click
If curscreen <> "6" Then
activateproperties()
lastscreen = lastscreen & "6"
End If
End Sub
Private Sub bdebug_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles bdebug.Click
If curscreen <> "7" Then
activatedebug()
lastscreen = lastscreen & "7"
End If
End Sub
Private Sub bexchange_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles bexchange.Click
If curscreen <> "8" Then
activateexchange()
lastscreen = lastscreen & "8"
End If
End Sub
Private Sub checkdebugscroll_CheckedChanged(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles checkdebugscroll.CheckedChanged
If checkdebugscroll.Checked = True Then txtdebug.ScrollBars = ScrollBars.Vertical
If checkdebugscroll.Checked = False Then txtdebug.ScrollBars = ScrollBars.None
End Sub
Private Sub lnkdebug_LinkClicked(ByVal sender As System.Object, ByVal e As System.Windows.Forms.LinkLabelLinkClickedEventArgs) Handles lnkdebug.LinkClicked
'disabled for now
Exit Sub
If debuglevel = 1 Then
debuglevel = 2
lnkdebug.Text = "MED"
Exit Sub
End If
If debuglevel = 2 Then
debuglevel = 3
lnkdebug.Text = "HIGH"
Exit Sub
End If
If debuglevel = 3 Then
debuglevel = 1
lnkdebug.Text = "LOW"
Exit Sub
End If
End Sub
'//////////////////////////////
'/// BACKGROUND WORKER
'//////////////////////////////
Private Sub workthread_ProgressChanged(ByVal sender As Object, ByVal e As System.ComponentModel.ProgressChangedEventArgs) Handles workthread.ProgressChanged
Dim bluepen As New Pen(Color.FromArgb(51, 153, 255), 2)
Dim greypen As New Pen(Color.FromArgb(65, 65, 65), 2)
Dim greenpen As New Pen(Color.FromArgb(51, 255, 153), 2)
Dim fig As Integer
If InStr(e.UserState.ToString, "%") Then
fig = Val(e.UserState.ToString.Substring(0, Len(e.UserState.ToString) - 1))
lsyncing.Text = "Processing (" & fig & "%)..."
If fig Mod 2 = 0 Then
Dim blueline As System.Drawing.Graphics = CreateGraphics()
blueline.DrawLine(bluepen, Convert.ToInt32(556), Convert.ToInt32(32), Convert.ToInt32(fig + 556), Convert.ToInt32(32))
blueline.DrawLine(greypen, Convert.ToInt32(fig + 556), Convert.ToInt32(32), Convert.ToInt32(656), Convert.ToInt32(32))
End If
Application.DoEvents()
Else
If InStr(e.UserState.ToString, "#") Then
fig = Val(e.UserState.ToString.Substring(0, Len(e.UserState.ToString) - 1))
lsyncing.Text = "Synchronizing (" & fig & "%)..."
Dim greenline As System.Drawing.Graphics = CreateGraphics()
greenline.DrawLine(greenpen, Convert.ToInt32(556), Convert.ToInt32(32), Convert.ToInt32(fig + 556), Convert.ToInt32(32))
greenline.DrawLine(greypen, Convert.ToInt32(fig + 556), Convert.ToInt32(32), Convert.ToInt32(656), Convert.ToInt32(32))
Application.DoEvents()
Else
Me.txtdebug.AppendText(vbCrLf & e.UserState.ToString)
If InStr(e.UserState.ToString, "Transaction processing") Then
loversync.Text = "Processing..."
Me.Refresh()
End If
If InStr(e.UserState.ToString, "DEBUG: Block Analysis for: ") Then loversync.Text = "Synchronizing... Current Block: " & e.UserState.ToString.Substring((Len(e.UserState.ToString) - 6), 6) & "..."
End If
End If
End Sub
Private Sub workthread_DoWork(ByVal senderobj As System.Object, ByVal e As System.ComponentModel.DoWorkEventArgs) Handles workthread.DoWork
'declare globalization to make sure we use a . for decimal only
Dim customCulture As System.Globalization.CultureInfo = System.Threading.Thread.CurrentThread.CurrentCulture.Clone()
customCulture.NumberFormat.NumberDecimalSeparator = "."
System.Threading.Thread.CurrentThread.CurrentCulture = customCulture
System.Threading.Thread.CurrentThread.CurrentUICulture = customCulture
varsyncronized = False
workthread.ReportProgress(0, "[" & DateTime.Now.ToString("s") & "] DEBUG: Thread 'workthread' starting...")
'test connection to bitcoind
Try
Dim checkhash As blockhash = mlib.getblockhash(bitcoin_con, 2)
If checkhash.result.ToString = "000000006a625f06636b8bb6ac7b960a8d03705d1ace08b1a19da3fdcc99ddbd" Then 'we've got a correct response
workthread.ReportProgress(0, "[" & DateTime.Now.ToString("s") & "] STATUS: Connection to bitcoin RPC established & sanity check OK.")
Else
'something has gone wrong
workthread.ReportProgress(0, "[" & DateTime.Now.ToString("s") & "] ERROR: Connection to bitcoin RPC seems to be established but responses are not as expected." & vbCrLf & "STATUS: UI thread will remain but blockchain scanning thread will now exit.")
Exit Sub
End If
Catch
Exit Sub
End Try
'test connection to database
Dim testval As Integer
testval = SQLGetSingleVal("SELECT count(*) FROM information_schema.columns WHERE table_name = 'processedblocks'")
If testval = 99 Then Exit Sub
If testval = 3 Then 'sanity check ok
workthread.ReportProgress(0, "[" & DateTime.Now.ToString("s") & "] STATUS: Connection to database established & sanity check OK.")
Else
'something has gone wrong
workthread.ReportProgress(0, "[" & DateTime.Now.ToString("s") & "] ERROR: Connection to database seems to be established but responses are not as expected." & vbCrLf & "STATUS: UI thread will remain but blockchain scanning thread will now exit.")
Exit Sub
End If
Application.DoEvents()
'### we have confirmed our connections to resources external to the program ###
'check transaction list for last database block and update from there - always delete current last block transactions and go back one ensuring we don't miss transactions if code bombs while processing a block
Dim dbposition As Integer
Dim dbposhash, rpcposhash As String
dbposition = SQLGetSingleVal("SELECT MAX(BLOCKNUM) FROM processedblocks")
If dbposition > 249497 Then dbposition = dbposition - 1 Else dbposition = 249497 'roll database back a block as long as hash matches, otherwise roll back 50 blocks
'dbposition = 249497 'force roll back to first MP tx
'dbposition = 292635 'force roll back to first SP tx
'dbposition block hash check
dbposhash = SQLGetSingleVal("SELECT blockhash FROM processedblocks where blocknum=" & dbposition)
Dim tmpblockhash As blockhash = mlib.getblockhash(bitcoin_con, dbposition)
rpcposhash = tmpblockhash.result.ToString
If rpcposhash <> dbposhash Then
workthread.ReportProgress(0, "[" & DateTime.Now.ToString("s") & "] WARNING: Reorg protection initiated, rolling back 50 blocks for safety")
dbposition = dbposition - 50
End If
'delete transactions after dbposition block
Dim txdeletedcount = SQLGetSingleVal("DELETE FROM transactions WHERE BLOCKNUM > " & dbposition - 1)
Dim blockdeletedcount = SQLGetSingleVal("DELETE FROM processedblocks WHERE BLOCKNUM > " & dbposition - 1)
Dim exodeletedcount = SQLGetSingleVal("DELETE FROM exotransactions WHERE BLOCKNUM > " & dbposition - 1)
workthread.ReportProgress(0, "[" & DateTime.Now.ToString("s") & "] STATUS: Database starting at block " & dbposition.ToString)
'System.Threading.Thread.Sleep(10000)
'check bitcoin RPC for latest block
Dim rpcblock As Integer
Dim blockcount As blockcount = mlib.getblockcount(bitcoin_con)
rpcblock = blockcount.result
workthread.ReportProgress(0, "[" & DateTime.Now.ToString("s") & "] STATUS: Network is at block " & rpcblock.ToString)
'if db block is newer than bitcoin rpc (eg new bitcoin install with preseed db)
If rpcblock < dbposition Then
workthread.ReportProgress(0, "[" & DateTime.Now.ToString("s") & "] ERROR: Database block appears newer than bitcoinrpc blocks - is bitcoinrpc up to date? Exiting thread.")
Exit Sub
End If
'calculate catchup
Dim catchup As Integer
catchup = rpcblock - dbposition
workthread.ReportProgress(0, "[" & DateTime.Now.ToString("s") & "] STATUS: " & (catchup + 1).ToString & " blocks to catch up")
'### loop through blocks since dbposition and add any transactions detected as mastercoin to the transactions table
Dim msctranscount As Integer
msctranscount = 0
Dim msctrans(100000) As String
For x = dbposition To rpcblock
Dim blocknum As Integer = x
If debuglevel > 0 Then workthread.ReportProgress(0, "[" & DateTime.Now.ToString("s") & "] DEBUG: Block Analysis for: " & blocknum.ToString)
Dim perccomp As Integer = ((x - dbposition) / (catchup + 1)) * 100
workthread.ReportProgress(0, perccomp.ToString & "#")
Dim blockhash As blockhash = mlib.getblockhash(bitcoin_con, blocknum)
Dim block As Block = mlib.getblock(bitcoin_con, blockhash.result.ToString)
Dim txarray() As String = block.result.tx.ToArray
For j = 1 To UBound(txarray) 'skip tx0 which should be coinbase
Try
Dim workingtxtype As String = mlib.ismastercointx(bitcoin_con, txarray(j))
'simple send
If workingtxtype = "simple" Then
workthread.ReportProgress(0, "[" & DateTime.Now.ToString("s") & "] BLOCKSCAN: Found MSC transaction (simple send): " & txarray(j))
Dim results As txn = mlib.gettransaction(bitcoin_con, txarray(j))
'handle generate
If results.result.blocktime < 1377993875 Then 'before exodus cutofff
Dim mastercointxinfo As mastercointx = mlib.getmastercointransaction(bitcoin_con, txarray(j).ToString, "generate")
If mastercointxinfo.type = "generate" And mastercointxinfo.curtype = 0 Then
Dim dbwritemsc As Integer = SQLGetSingleVal("INSERT INTO transactions (TXID,FROMADD,TOADD,VALUE,TYPE,BLOCKTIME,BLOCKNUM,VALID,CURTYPE,VERSION) VALUES ('" & mastercointxinfo.txid & "','" & mastercointxinfo.fromadd & "','" & mastercointxinfo.toadd & "'," & mastercointxinfo.value & ",'" & mastercointxinfo.type & "'," & mastercointxinfo.blocktime & "," & blocknum & "," & mastercointxinfo.valid & ",1,0)")
Dim dbwritetmsc As Integer = SQLGetSingleVal("INSERT INTO transactions (TXID,FROMADD,TOADD,VALUE,TYPE,BLOCKTIME,BLOCKNUM,VALID,CURTYPE,VERSION) VALUES ('" & mastercointxinfo.txid & "','" & mastercointxinfo.fromadd & "','" & mastercointxinfo.toadd & "'," & mastercointxinfo.value & ",'" & mastercointxinfo.type & "'," & mastercointxinfo.blocktime & "," & blocknum & "," & mastercointxinfo.valid & ",2,0)")
End If
End If
'decode mastercoin transaction
Dim txdetails As mastercointx = mlib.getmastercointransaction(bitcoin_con, txarray(j).ToString, "send")
'see if we have a transaction back and if so write it to database
If Not IsNothing(txdetails) Then
Dim dbwrite9 As Integer = SQLGetSingleVal("INSERT INTO transactions (TXID,FROMADD,TOADD,VALUE,TYPE,BLOCKTIME,BLOCKNUM,VALID,CURTYPE,VERSION) VALUES ('" & txdetails.txid & "','" & txdetails.fromadd & "','" & txdetails.toadd & "'," & txdetails.value & ",'" & txdetails.type & "'," & txdetails.blocktime & "," & blocknum & "," & txdetails.valid & "," & txdetails.curtype & ",0)")
Else
If results.result.blocktime > 1377993875 Then 'after exodus cutofff
Dim btctxdetails As mastercointx_btcpayment = mlib.getmastercointransaction(bitcoin_con, txarray(j).ToString, "btcpayment")
If Not IsNothing(btctxdetails) Then Dim dbwrite2 As Integer = SQLGetSingleVal("INSERT INTO transactions (TXID,FROMADD,TYPE,BLOCKTIME,BLOCKNUM,CURTYPE,VOUTS,VALID) VALUES ('" & btctxdetails.txid & "','" & btctxdetails.fromadd & "','btcpayment'," & btctxdetails.blocktime & "," & blocknum & ",0,'" & btctxdetails.vouts & "',1)")
End If
End If
End If
'===DEx messages===
'sell offer
If workingtxtype = "selloffer" Then
workthread.ReportProgress(0, "[" & DateTime.Now.ToString("s") & "] BLOCKSCAN: Found MSC transaction (sell offer): " & txarray(j))
Dim txdetails As mastercointx_selloffer = mlib.getmastercointransaction(bitcoin_con, txarray(j).ToString, "selloffer")
'see if we have a transaction back and if so write it to database
If Not IsNothing(txdetails) Then Dim dbwrite4 As Integer = SQLGetSingleVal("INSERT INTO transactions (TXID,FROMADD,SALEAMOUNT,OFFERAMOUNT,MINFEE,TIMELIMIT,TYPE,BLOCKTIME,BLOCKNUM,VALID,CURTYPE,VERSION,ACTION) VALUES ('" & txdetails.txid & "','" & txdetails.fromadd & "'," & txdetails.saleamount & "," & txdetails.offeramount & "," & txdetails.minfee & "," & txdetails.timelimit & ",'" & txdetails.type & "'," & txdetails.blocktime & "," & blocknum & "," & txdetails.valid & "," & txdetails.curtype & "," & txdetails.version & "," & txdetails.action & ")")
End If
'accept offer
If workingtxtype = "acceptoffer" Then
workthread.ReportProgress(0, "[" & DateTime.Now.ToString("s") & "] BLOCKSCAN: Found MSC transaction (accept offer): " & txarray(j))
Dim txdetails As mastercointx_acceptoffer = mlib.getmastercointransaction(bitcoin_con, txarray(j).ToString, "acceptoffer")
'see if we have a transaction back and if so write it to database
If Not IsNothing(txdetails) Then Dim dbwrite4 As Integer = SQLGetSingleVal("INSERT INTO transactions (TXID,FROMADD,TOADD,PURCHASEAMOUNT,TYPE,BLOCKTIME,BLOCKNUM,VALID,CURTYPE,VERSION,FEE) VALUES ('" & txdetails.txid & "','" & txdetails.fromadd & "','" & txdetails.toadd & "'," & txdetails.purchaseamount & ",'" & txdetails.type & "'," & txdetails.blocktime & "," & blocknum & "," & txdetails.valid & "," & txdetails.curtype & ",0," & txdetails.fee & ")")
End If
'===SP messages===
'created SP - fixed
If workingtxtype = "spcreatefixed" Then
workthread.ReportProgress(0, "[" & DateTime.Now.ToString("s") & "] BLOCKSCAN: Found MSC transaction (create SP fixed): " & txarray(j))
Dim txdetails As mastercointx_spfixed = mlib.getmastercointransaction(bitcoin_con, txarray(j).ToString, "spcreatefixed")
'see if we have a transaction back and if so write it to database
If Not IsNothing(txdetails) Then Dim dbwrite4 As Integer = SQLGetSingleVal("INSERT INTO transactions (TXID,FROMADD,TYPE,BLOCKTIME,BLOCKNUM,VALID,ECOSYSTEM,PROPTYPE,PREVID,STRCAT,STRSUBCAT,STRNAME,STRURL,STRDATA,SALEAMOUNT,CURTYPE,VERSION) VALUES ('" & txdetails.txid & "','" & txdetails.fromadd & "','" & txdetails.type & "'," & txdetails.blocktime & "," & blocknum & "," & txdetails.valid & "," & txdetails.ecosystem & "," & txdetails.propertytype & "," & txdetails.previousid & ",'" & txdetails.category & "','" & txdetails.subcategory & "','" & txdetails.name & "','" & txdetails.url & "','" & txdetails.data & "'," & txdetails.numberproperties & ",9999999999,0)")
End If
'create SP - variable (fundraiser)
If workingtxtype = "spcreatevar" Then
workthread.ReportProgress(0, "[" & DateTime.Now.ToString("s") & "] BLOCKSCAN: Found MSC transaction (create SP crowdsale): " & txarray(j))
Dim txdetails As mastercointx_spvar = mlib.getmastercointransaction(bitcoin_con, txarray(j).ToString, "spcreatevar")
'see if we have a transaction back and if so write it to database
If Not IsNothing(txdetails) Then Dim dbwrite4 As Integer = SQLGetSingleVal("INSERT INTO transactions (TXID,FROMADD,TYPE,BLOCKTIME,BLOCKNUM,VALID,ECOSYSTEM,PROPTYPE,PREVID,STRCAT,STRSUBCAT,STRNAME,STRURL,STRDATA,CURTYPE,SALEAMOUNT,DEADLINE,EARLYBONUS,PERCENTISSUER,VERSION) VALUES ('" & txdetails.txid & "','" & txdetails.fromadd & "','" & txdetails.type & "'," & txdetails.blocktime & "," & blocknum & "," & txdetails.valid & "," & txdetails.ecosystem & "," & txdetails.propertytype & "," & txdetails.previousid & ",'" & txdetails.category & "','" & txdetails.subcategory & "','" & txdetails.name & "','" & txdetails.url & "','" & txdetails.data & "'," & txdetails.currencydesired & "," & txdetails.numberpropertiesperunit & "," & txdetails.deadline & "," & txdetails.earlybonus & "," & txdetails.percentforissuer & ",0)")
End If
'create SP - variable (fundraiser)
If workingtxtype = "spcancelvar" Then
workthread.ReportProgress(0, "[" & DateTime.Now.ToString("s") & "] BLOCKSCAN: Found MSC transaction (cancel SP crowdsale): " & txarray(j))
Dim txdetails As mastercointx_spcancelvar = mlib.getmastercointransaction(bitcoin_con, txarray(j).ToString, "spcancelvar")
'see if we have a transaction back and if so write it to database
If Not IsNothing(txdetails) Then Dim dbwrite4 As Integer = SQLGetSingleVal("INSERT INTO transactions (TXID,FROMADD,TYPE,BLOCKTIME,BLOCKNUM,VALID,CURTYPE,VERSION) VALUES ('" & txdetails.txid & "','" & txdetails.fromadd & "','" & txdetails.type & "'," & txdetails.blocktime & "," & blocknum & "," & txdetails.valid & "," & txdetails.propid & ",0)")
End If
Catch exx As Exception
Console.WriteLine("ERROR: Exception occured." & vbCrLf & exx.Message & vbCrLf & "Exiting...")
End Try
Next
'only here do we write that the block has been processed to database
'insert dummy transaction to ensure all triggers are processed per block
Dim dbwrite33 As Integer = SQLGetSingleVal("INSERT INTO transactions (TXID,FROMADD,TYPE,BLOCKNUM,BLOCKTIME,VALID,CURTYPE,VERSION) VALUES ('DUMMY','DUMMY','DUMMY'," & blocknum & "," & block.result.time & ",0,0,0)")
Dim dbwrite3 As Integer = SQLGetSingleVal("INSERT INTO processedblocks VALUES (" & blocknum & "," & block.result.time & ",'" & block.result.hash & "')")
Next
workthread.ReportProgress(0, "100#")
'handle unconfirmed transactions
If debuglevel > 0 Then workthread.ReportProgress(0, "[" & DateTime.Now.ToString("s") & "] DEBUG: Block Analysis for pending transactions")
Dim btemplate As blocktemplate = mlib.getblocktemplate(bitcoin_con)
Dim intermedarray As bttx() = btemplate.result.transactions.ToArray
For j = 1 To UBound(intermedarray) 'skip tx0 which should be coinbase
Try
Dim workingtxtype As String = mlib.ismastercointx(bitcoin_con, intermedarray(j).hash)
'simple send
If workingtxtype = "simple" Then
workthread.ReportProgress(0, "[" & DateTime.Now.ToString("s") & "] BLOCKSCAN: Found pending MSC transaction (simple send): " & intermedarray(j).hash)
'decode mastercoin transaction
Dim txdetails As mastercointx = mlib.getmastercointransaction(bitcoin_con, intermedarray(j).hash.ToString, "send")
If Not IsNothing(txdetails) Then
Dim dbwrite9 As Integer = SQLGetSingleVal("INSERT INTO transactions (TXID,FROMADD,TOADD,VALUE,TYPE,BLOCKTIME,BLOCKNUM,VALID,CURTYPE,VERSION) VALUES ('" & txdetails.txid & "','" & txdetails.fromadd & "','" & txdetails.toadd & "'," & txdetails.value & ",'" & txdetails.type & "'," & txdetails.blocktime & ",999999," & txdetails.valid & "," & txdetails.curtype & ",0)")
Else
Dim btctxdetails As mastercointx_btcpayment = mlib.getmastercointransaction(bitcoin_con, intermedarray(j).hash.ToString, "btcpayment")
If Not IsNothing(btctxdetails) Then Dim dbwrite2 As Integer = SQLGetSingleVal("INSERT INTO transactions (TXID,FROMADD,TYPE,BLOCKTIME,BLOCKNUM,CURTYPE,VOUTS,VALID) VALUES ('" & btctxdetails.txid & "','" & btctxdetails.fromadd & "','btcpayment'," & btctxdetails.blocktime & ",999999,0,'" & btctxdetails.vouts & "',1)")
End If
End If
If workingtxtype = "selloffer" Then
workthread.ReportProgress(0, "[" & DateTime.Now.ToString("s") & "] BLOCKSCAN: Found pending MSC transaction (sell offer): " & intermedarray(j).hash)
'decode mastercoin transaction
Dim txdetails As mastercointx_selloffer = mlib.getmastercointransaction(bitcoin_con, intermedarray(j).hash.ToString, "selloffer")
'see if we have a transaction back and if so write it to database
If Not IsNothing(txdetails) Then Dim dbwrite4 As Integer = SQLGetSingleVal("INSERT INTO transactions (TXID,FROMADD,SALEAMOUNT,OFFERAMOUNT,MINFEE,TIMELIMIT,TYPE,BLOCKTIME,BLOCKNUM,VALID,CURTYPE,VERSION,ACTION) VALUES ('" & txdetails.txid & "','" & txdetails.fromadd & "'," & txdetails.saleamount & "," & txdetails.offeramount & "," & txdetails.minfee & "," & txdetails.timelimit & ",'" & txdetails.type & "'," & txdetails.blocktime & ",999999," & txdetails.valid & "," & txdetails.curtype & "," & txdetails.version & "," & txdetails.action & ")")
End If
If workingtxtype = "acceptoffer" Then
workthread.ReportProgress(0, "[" & DateTime.Now.ToString("s") & "] BLOCKSCAN: Found pending MSC transaction (accept offer): " & intermedarray(j).hash)
Dim txdetails As mastercointx_acceptoffer = mlib.getmastercointransaction(bitcoin_con, intermedarray(j).hash.ToString, "acceptoffer")
'see if we have a transaction back and if so write it to database
If Not IsNothing(txdetails) Then Dim dbwrite4 As Integer = SQLGetSingleVal("INSERT INTO transactions (TXID,FROMADD,TOADD,PURCHASEAMOUNT,TYPE,BLOCKTIME,BLOCKNUM,VALID,CURTYPE,VERSION,FEE) VALUES ('" & txdetails.txid & "','" & txdetails.fromadd & "','" & txdetails.toadd & "'," & txdetails.purchaseamount & ",'" & txdetails.type & "'," & txdetails.blocktime & ",999999," & txdetails.valid & "," & txdetails.curtype & ",0," & txdetails.fee & ")")
End If
Catch exx As Exception
Console.WriteLine("ERROR: Exception occured looking at unconfirmed transactions." & vbCrLf & exx.Message & vbCrLf & "Exiting...")
End Try
Next
'///process transactions
workthread.ReportProgress(0, "[" & DateTime.Now.ToString("s") & "] BLOCKSCAN: Transaction processing starting... ")
' Try
Dim nextfrexpiry As Long = 9999999999
'dev sends temp
Dim maxtime As Long = SQLGetSingleVal("SELECT MAX(BLOCKTIME) FROM processedblocks")
Dim devmsc As Double = Math.Round(((1 - (0.5 ^ ((maxtime - 1377993874) / 31556926))) * 56316.23576222), 8)
'do all generate transactions and calculate initial balances
Dim con As New SqlCeConnection("data source=" & Application.StartupPath & "\wallet.sdf")
Dim cmd As New SqlCeCommand()
cmd.Connection = con
con.Open()
cmd.CommandText = "delete from transactions_processed_temp"
cmd.ExecuteNonQuery()
cmd.CommandText = "delete from balances_temp2"
cmd.ExecuteNonQuery()
cmd.CommandText = "delete from exchange_temp"
cmd.ExecuteNonQuery()
cmd.CommandText = "delete from properties_temp"
cmd.ExecuteNonQuery()
cmd.CommandText = "delete from fundraisers_temp"
cmd.ExecuteNonQuery()
cmd.CommandText = "insert into properties_temp values ('1EXoDusjGwvnjZUyKkxZ4UHEf77z6A5S4P',1,'Mastercoin','N/A','N/A','N/A','N/A',1)"
cmd.ExecuteNonQuery()
cmd.CommandText = "insert into properties_temp values ('1EXoDusjGwvnjZUyKkxZ4UHEf77z6A5S4P',2,'Test Mastercoin','N/A','N/A','N/A','N/A',1)"
cmd.ExecuteNonQuery()
cmd.CommandText = "insert into transactions_processed_temp (TXID,FROMADD,TOADD,VALUE,TYPE,BLOCKTIME,BLOCKNUM,VALID,CURTYPE) SELECT TXID,FROMADD,TOADD,VALUE,TYPE,BLOCKTIME,BLOCKNUM,VALID,CURTYPE from transactions where type='generate'"
cmd.ExecuteNonQuery()
cmd.CommandText = "insert into balances_temp2 (address, curtype, cbalance, ubalance) SELECT TOADD,1,SUM(VALUE),0 from transactions_processed_temp where curtype = 1 group by toadd"
cmd.ExecuteNonQuery()
cmd.CommandText = "insert into balances_temp2 (address, curtype, cbalance, ubalance) SELECT TOADD,2,SUM(VALUE),0 from transactions_processed_temp where curtype = 2 group by toadd"
cmd.ExecuteNonQuery()
cmd.CommandText = "insert into balances_temp2 (address, curtype, cbalance, ubalance) VALUES ('1EXoDusjGwvnjZUyKkxZ4UHEf77z6A5S4P',1," & (devmsc * 100000000) & ",0)"
cmd.ExecuteNonQuery()
'try and speed things up a little - drop some indexes into the right places
'cmd.CommandText = "create unique index balindex on balances_temp2(address)"
'cmd.ExecuteNonQuery()
'cmd.CommandText = "create unique index dexindex on exchange_temp(fromadd)"
'cmd.ExecuteNonQuery()
'go through transactions, check validity, process by type and apply to balances
Dim sqlquery
Dim pendinglist As New List(Of String)
Dim tmpblknum As Integer = 0
Dim lasttmpblknum As Integer = 0
Dim returnval
sqlquery = "SELECT * FROM transactions order by ID ASC"
cmd.CommandText = sqlquery
Dim adptSQL As New SqlCeDataAdapter(cmd)
Dim ds1 As New DataSet()
adptSQL.Fill(ds1)
'get total number of transactions to process
Dim totaltxcount As Integer = ds1.Tables(0).Rows.Count
With ds1.Tables(0)
For rowNumber As Integer = 0 To .Rows.Count - 1
With .Rows(rowNumber)
tmpblknum = .Item(6)
'update progress (don't go overboard - just every ten txs)
If (rowNumber Mod 80) = 0 Then
Dim percentdone As Integer = (rowNumber / totaltxcount) * 100
workthread.ReportProgress(0, percentdone.ToString & "%")
End If
'#####################################
'START PRE-TRANSACTION HANDLING CHECKS
'#####################################
'============================
'START CROWDSALE EXPIRY CHECK
'============================
If nextfrexpiry < .Item(5) Then
'a fundraiser has expired - what if multiple? loop through active fundraisers instead of blanket update - done
sqlquery = "SELECT * FROM fundraisers_temp where ACTIVE=1 AND deadline<" & .Item(5).ToString
cmd.CommandText = sqlquery
Dim adptSQLcrowd As New SqlCeDataAdapter(cmd)
Dim dscrowd As New DataSet()
adptSQLcrowd.Fill(dscrowd)
With dscrowd.Tables(0)
For rowcrowd As Integer = 0 To .Rows.Count - 1
With .Rows(rowcrowd)
'get crowdsale txid, address & start/end times
Dim cstxid = .Item(0)
Dim csadd = .Item(1)
Dim csstart = .Item(5)
Dim csend = .Item(6)
Dim icurdesired = .Item(2)
Dim icurtype = .Item(3)
Dim iamountperunit = .Item(4)
Dim iearlybird = .Item(7)
Dim iissuerpercent = .Item(8)
'was there an issuer cut? if so go through and add missing fractions
If iissuerpercent > 0 Then '###START ISSUER FRACTION CATCH UP
Dim totalaward As ULong = 0
Dim totalraised As ULong = 0
Dim totalcut As ULong = 0
sqlquery = "SELECT * FROM transactions_processed where type='investment' AND toadd='" + csadd + "' AND blocktime>" + csstart.ToString + " AND blocktime<=" + csend.ToString
cmd.CommandText = sqlquery
Dim adptSQLfund As New SqlCeDataAdapter(cmd)
Dim dsfund As New DataSet()
adptSQLfund.Fill(dsfund)
With dsfund.Tables(0)
For rowfund As Integer = 0 To .Rows.Count - 1
With .Rows(rowfund)
'get amount awarded and add to totalawarded
Dim txamount = .Item(3)
Dim txtime = .Item(5)
Dim curtype = .Item(8)
'calculate investment
Dim srcamount As ULong = txamount
Dim investunits As Double = 0
Dim perunit As ULong = 0
Dim investreturn As Double = 0
'are funds being invested divisble?
cmd.CommandText = "select divisible from properties_temp where curtype=" & curtype
Dim srcdivisible As Boolean = cmd.ExecuteScalar
If srcdivisible = True Then
investunits = srcamount / 100000000
Else
investunits = srcamount
End If
'are tokens being returned divisible?
cmd.CommandText = "select divisible from properties_temp where curtype=" & icurtype
Dim dstdivisible As Boolean = cmd.ExecuteScalar
perunit = iamountperunit
'investment return
investreturn = investunits * perunit
'calculate bonus
Dim dif As Long = csend - txtime
Dim bonus As Double = (iearlybird / 100) * (dif / 604800)
If bonus < 0 Then bonus = 0 'avoid negative bonus
'apply bonus to investment return
investreturn = investreturn * (1 + bonus)
'truncate and shift to long ready to write to db
investreturn = Math.Truncate(investreturn)
Dim investreturnlong As ULong = investreturn
'calculate % for issuer
Dim issuercutlong As ULong
If iissuerpercent > 0 Then
Dim issuercut As Double = investreturn * (iissuerpercent / 100)
'truncate and shift to long ready to write to db
issuercut = Math.Truncate(issuercut)
issuercutlong = issuercut
End If
'add to totals
totalraised = totalraised + investreturnlong
totalaward = totalaward + issuercutlong
End With
Next
End With
'get amount that should have been awarded
Dim totalcutdub As Double = totalraised * (iissuerpercent / 100)
totalcut = Math.Truncate(totalcutdub)
'if short, credit extra fractions
If totalcut > totalaward Then
'grant to issuer
cmd.CommandText = "UPDATE balances_temp2 SET CBALANCE=CBALANCE+" & (totalcut - totalaward) & " where CURTYPE=" & icurtype & " AND ADDRESS='" & csadd & "'"
returnval = cmd.ExecuteNonQuery 'if 0 rows affected, address/curtype combo doesn't exist so insert it
If returnval = 0 Then
cmd.CommandText = "INSERT INTO balances_temp2 (ADDRESS,CURTYPE,CBALANCE,UBALANCE) VALUES ('" & csadd & "'," & icurtype & "," & (totalcut - totalaward) & ",0)"
returnval = cmd.ExecuteScalar
End If
End If
End If '###END ISSUER FRACTION CATCHUP
'deactivate it
cmd.CommandText = "update fundraisers_temp set active=0 where txid='" & cstxid & "'"
returnval = cmd.ExecuteScalar
'update next deadline
cmd.CommandText = "select min(deadline) from fundraisers_temp"
returnval = cmd.ExecuteScalar
If Not IsDBNull(returnval) Then
If Not returnval > 0 Then
nextfrexpiry = 9999999999
Else
nextfrexpiry = returnval
End If
Else
nextfrexpiry = 9999999999
End If
End With
Next
End With
End If
'==========================
'END CROWDSALE EXPIRY CHECK
'==========================
'================================
'START PENDING OFFER EXPIRY CHECK
'================================
If pendinglist.Count > 0 And tmpblknum > 0 And tmpblknum <> lasttmpblknum Then '
Dim startpen As Long = (DateTime.UtcNow - New DateTime(1970, 1, 1, 0, 0, 0)).TotalMilliseconds
lasttmpblknum = tmpblknum
'blocktime has changed - get new blocknum
'optimization no need to go out to sqlce every block here, big waste of time - already have current blocknum in .item(6) - switch away from blocktime to blocknum
'get any expired pendingoffers
sqlquery = "select txid,matchingtx,purchaseamount,curtype,toadd,fromadd from transactions_processed_temp where type='pendingoffer' and expiry<" & tmpblknum
cmd.CommandText = sqlquery
Dim refundtxid As String = ""
Dim selltype As String = ""
Dim adptSQLexp As New SqlCeDataAdapter(cmd)
Dim dsexp As New DataSet()
adptSQLexp.Fill(dsexp)
With dsexp.Tables(0)
For rownum As Integer = 0 To .Rows.Count - 1
With .Rows(rownum)
Dim tmpcur2 As Integer = .Item(3)
'flip pending to expired
sqlquery = "update transactions_processed_temp SET type='expiredoffer' where txid='" & .Item(0) & "'"
cmd.CommandText = sqlquery
returnval = cmd.ExecuteScalar
'remove from pendinglist
pendinglist.Remove(.Item(0))
'return reserved funds
sqlquery = "SELECT txid FROM exchange_temp where fromadd='" & .Item(4).ToString & "' and curtype=" & .Item(3).ToString
cmd.CommandText = sqlquery
refundtxid = cmd.ExecuteScalar
If refundtxid <> "" Then
sqlquery = "SELECT type FROM exchange_temp where txid='" & refundtxid & "'"
cmd.CommandText = sqlquery
selltype = cmd.ExecuteScalar
sqlquery = "update exchange_temp SET reserved=reserved-" & .Item(2).ToString & " where txid='" & refundtxid & "'"
cmd.CommandText = sqlquery
returnval = cmd.ExecuteScalar
sqlquery = "update exchange_temp SET saleamount=saleamount+" & .Item(2).ToString & " where txid='" & refundtxid & "'"
cmd.CommandText = sqlquery
returnval = cmd.ExecuteScalar
If selltype = "sellpendingcancel" Then
'sell has been cancelled
'attempt cancellation again - credit back remaining saleamount
'get sell details from exchange table
Dim tmpreserved As Long
Dim tmpsaleamount As Long
sqlquery = "SELECT RESERVED FROM exchange_temp where txid='" & refundtxid & "'"
cmd.CommandText = sqlquery
returnval = cmd.ExecuteScalar
If IsDBNull(returnval) Then
tmpreserved = 0
Else
tmpreserved = returnval
End If
sqlquery = "SELECT SALEAMOUNT FROM exchange_temp where txid='" & refundtxid & "'"
cmd.CommandText = sqlquery
returnval = cmd.ExecuteScalar
If IsDBNull(returnval) Then
tmpsaleamount = 0
Else
tmpsaleamount = returnval
End If
cmd.CommandText = "UPDATE balances_temp2 SET CBALANCE=CBALANCE+" & tmpsaleamount & " where CURTYPE=" & .Item(3).ToString & " AND ADDRESS='" & .Item(4).ToString & "'"
returnval = cmd.ExecuteScalar
If tmpreserved = 0 Then 'nothing reserved, cancel whole sell
'delete it from exchange table
sqlquery = "DELETE FROM exchange_temp where txid='" & refundtxid & "'"
cmd.CommandText = sqlquery
returnval = cmd.ExecuteScalar
Else 'funds reserved, zero saleamount but do not remove sell as still active
cmd.CommandText = "UPDATE exchange_temp SET SALEAMOUNT=0 where txid='" & refundtxid & "'"
returnval = cmd.ExecuteScalar
End If
End If
End If
End With
Next
End With
End If
'================================
'END PENDING OFFER EXPIRY CHECK
'================================
'#####################################
'END PRE-TRANSACTION HANDLING CHECKS
'#####################################
'###################################
'START TRANSACTION HANDLING ROUTINES
'###################################
'=================================
'START SIMPLE SEND PROCESSING CODE
'=================================
If .Item(4) = "simple" Then
'get vars for transaction
Dim curtype As UInteger = .Item(8)
Dim txamount As Long = .Item(3)
Dim sender As String = .Item(1)
Dim recip As String = .Item(2)
Dim sendtxtype As String = "simple"
'check if send is going to an open crowdsale - should be 1 or 0 crowdsales, flip type to investment if there is active crowdsale on this address/curtype
cmd.CommandText = "SELECT count(address) from fundraisers_temp where ADDRESS='" & recip & "' and CURDESIRED=" & curtype & "AND active=1"
returnval = cmd.ExecuteScalar
If returnval = 1 Then sendtxtype = "investment"
If curtype > 0 Then 'sanity check not CurID:0
'check if transaction amount is over senders balance
cmd.CommandText = "UPDATE balances_temp2 SET CBALANCE=CBALANCE-" & txamount & " where CURTYPE=" & curtype & " AND ADDRESS='" & sender & "' AND CBALANCE>=" & txamount
returnval = cmd.ExecuteNonQuery