📄 frmserver.frm
字号:
VERSION 5.00
Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "COMDLG32.OCX"
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCTL.OCX"
Begin VB.Form frmServer
BorderStyle = 1 'Fixed Single
Caption = "File Transfer (Server)"
ClientHeight = 2010
ClientLeft = 5385
ClientTop = 4410
ClientWidth = 5385
BeginProperty Font
Name = "Times New Roman"
Size = 9
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
LinkTopic = "Form1"
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 2010
ScaleWidth = 5385
Begin VB.TextBox txtfilenumber
Height = 495
Left = 2040
TabIndex = 14
Top = 720
Visible = 0 'False
Width = 1215
End
Begin VB.TextBox txtPassword
Height = 330
Left = 5400
TabIndex = 13
Top = 840
Visible = 0 'False
Width = 150
End
Begin VB.TextBox txtupb
Height = 1965
Left = 0
MultiLine = -1 'True
TabIndex = 12
Top = 2040
Visible = 0 'False
Width = 9975
End
Begin VB.TextBox txtProd
Height = 330
Left = 5400
TabIndex = 11
Top = 0
Visible = 0 'False
Width = 150
End
Begin VB.TextBox txtSecretKey
Height = 330
Left = 5400
TabIndex = 10
Top = 240
Visible = 0 'False
Width = 150
End
Begin VB.TextBox txtTemp
Height = 285
Left = 5400
TabIndex = 9
Top = 600
Visible = 0 'False
Width = 150
End
Begin MSComctlLib.ProgressBar ProgressBar1
Height = 360
Left = 75
TabIndex = 6
Top = 1290
Width = 5280
_ExtentX = 9313
_ExtentY = 635
_Version = 393216
Appearance = 1
End
Begin VB.CommandButton cmdSend
Caption = "&Send"
Height = 252
Left = 3030
TabIndex = 5
Top = 600
Width = 972
End
Begin VB.CommandButton cmdBrowse
Caption = "&Browse..."
Height = 252
Left = 4125
TabIndex = 4
Top = 315
Width = 972
End
Begin VB.TextBox txtFileName
Height = 300
Left = 60
TabIndex = 2
Top = 285
Width = 3960
End
Begin MSComDlg.CommonDialog cdOpen
Left = 4800
Top = 120
_ExtentX = 688
_ExtentY = 688
_Version = 393216
End
Begin VB.CommandButton cmdClose
Caption = "&Close"
Height = 252
Left = 4125
TabIndex = 0
Top = 630
Width = 972
End
Begin MSComctlLib.Slider Slider1
Height = 315
Left = 60
TabIndex = 7
Top = 915
Width = 5040
_ExtentX = 8890
_ExtentY = 556
_Version = 393216
Min = 1
SelStart = 1
TickStyle = 1
Value = 1
End
Begin VB.Label lblbuff
BackStyle = 0 'Transparent
Caption = "Buffer lenght"
Height = 240
Left = 75
TabIndex = 8
Top = 720
Width = 1425
End
Begin VB.Label Label3
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "File to send:"
Height = 210
Index = 0
Left = 60
TabIndex = 3
Top = 45
Width = 840
End
Begin VB.Label lblStatus
BorderStyle = 1 'Fixed Single
Caption = " Status : Listening......."
Height = 255
Left = 60
TabIndex = 1
Top = 1680
Width = 5295
End
End
Attribute VB_Name = "frmServer"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim lin As String
Dim dsize As Double
Dim i As Integer
Dim pdata(), pout, filepout, Fsave As String
Dim adata(100000) As Integer
Dim out(100000), q As Double
Dim linefeed, rlinefeed As String
Dim tryI, tryJ, jval As Long
Dim i1, a1 As Long
Dim GetRndA, GetRndB, indexA, indexB, RndValA, RndValB, primeA, primeB, opA, opB As Long
Dim chkA, chkB, tstA, tstB As Boolean
Dim cont As Boolean
Dim PRIME1, PRIME2, PROD, PHIE, PUBLICKEY, SECRETKEY, POS As Long
Dim CIPHER As String
Dim y, X, n As Long
Dim store(9999), mtp, temp, flmt, disp(15), t, rvf(15), res, pcnt, suma(15) As Long
Dim pow(15), ch(14), a, c, il, cnt, j, jp, kt, lt, L, j1, ic, jc As Long
Dim op, t2 As String
Dim gt(15), rv(15), lent, chlen, dval As Integer
Dim gate, fin As Boolean
Dim Fname As Variant
Public Function Send_Click()
Dim FName_Only As String
Dim FileName12 As String
Dim rxdata As String
Dim fnum As String
Dim SECRETKEY, PROD As Long
Dim todec As String
FileName12 = frmWSK.Text1.Text
Open FileName12 For Input As #1
rxdata = Input(LOF(1), 1)
Close #1
SECRETKEY = Mid(rxdata, InStr(1, rxdata, ",") + 1, InStrRev(rxdata, ",", -1) - InStr(1, rxdata, ",") - 1)
PROD = Mid(rxdata, InStrRev(rxdata, ",", -1) + 1, InStr(1, rxdata, "end") - InStrRev(rxdata, ",", -1) - 1)
todec = Mid(rxdata, 1, InStr(1, rxdata, ",") - 3)
fnum = Mid(rxdata, InStr(1, rxdata, "end") + 3, 2)
txtfilenumber = fnum
txtSecretKey = SECRETKEY
txtProd = PROD
Open App.Path & "\" & "2_todec.txt" For Output As #2
Print #2, todec
Close #2
Decrypt
Pause 5000
End Function
Private Function Decrypt()
Dim password As String
Dim pwd As String
Dim delay As Long
Dim aa(1 To 16) As Long
Dim ii, d, jj As Integer
Dim upb, tempp As String
Dim ff, gg, aeskey As String
SECRETKEY = txtSecretKey.Text
PROD = txtProd.Text
Open App.Path & "\" & "2_todec.txt" For Input As #1
While Not EOF(1)
Line Input #1, lin
dsize = Len(lin)
If dsize > 0 Then
ReDim pdata(1 To dsize)
Else
ReDim pdata(1)
End If
rlinefeed = ""
j = ""
i = 1
Do Until i = dsize + 1
j = Mid(lin, i, 1)
rlinefeed = rlinefeed & j
i = i + 1
Loop
X = rlinefeed
y = SECRETKEY
n = PROD
t2 = ""
a = y
Do While a >= 2
c = a Mod 2
a = Fix(a / 2)
t2 = t2 & c
Loop
t2 = t2 & a
op = StrReverse(t2)
a = 1
Do While (gate = False)
c = Mid$(op, a, 1)
gt(a) = c
If (c <> 1 And c <> 0) Then
gate = True
End If
cnt = a
a = a + 1
Loop
lent = cnt - 1
a = 1
For c = lent To 1 Step -1
rv(a) = gt(c)
a = a + 1
Next c
L = 2
j = 1
kt = 2
pow(1) = rv(1)
ch(1) = pow(1)
lt = 2
chlen = 1
Do While (lt <= lent)
pow(j + 1) = rv(kt) * 2 ^ j
ch(L) = pow(j + 1)
chlen = chlen + 1
j = j + 1
kt = kt + 1
L = L + 1
lt = lt + 1
Loop
store(1) = X Mod n
temp = store(1)
disp(1) = temp
mtp = 2
flmt = 1
t = 2
Do While ((flmt / 2) <= Val(y))
store(mtp) = (temp ^ 2) Mod n
temp = store(mtp)
disp(t) = (store(mtp))
mtp = mtp * 2
flmt = mtp * 2
t = t + 1
Loop
i1 = 1
j1 = 2
rvf(1) = pow(1)
Do While (i1 < 15)
If ch(i1) <> 0 Then
rvf(j1) = ch(i1)
j1 = j1 + 1
End If
i1 = i1 + 1
Loop
pcnt = 1
jc = 1
For ic = 1 To chlen
If ch(ic) <> 0 Then
suma(jc) = (disp(ic))
pcnt = pcnt + 1
jc = jc + 1
End If
Next ic
res = 1
Dim q1 As Integer
res = (suma(1) * suma(2)) Mod n
For q1 = 2 To (pcnt - 2)
res = (res * suma(q1 + 1)) Mod n
Next q1
pout = Chr(res)
Dim loc As Integer
filepout = filepout & pout
X = y = n = res = 0
Wend
Close #1
Open App.Path & "\" & "3_upb.txt" For Output As #2
Print #2, filepout
Close #2
txtupb = filepout
pwd = Mid(txtupb, 1, 4) + Mid(txtupb, 21, 4) + Right(txtupb, 8)
fRijndael.Text3 = Mid(txtupb, 41)
upb = pwd
For ii = 1 To 16
aa(ii) = Asc(Mid(upb, ii, 1))
For jj = 1 To 16
If (aa(ii) > aa(jj)) Then
d = 1
Else
tempp = aa(jj)
aa(jj) = aa(ii)
aa(ii) = tempp
End If
Next jj
Next ii
gg = ""
For ii = 1 To 16
ff = Chr(aa(ii))
gg = gg + ff
Next ii
aeskey = gg
txtPassword = aeskey
For delay = 0 To 100000
Next delay
Load frmencrypt
End Function
Private Sub Form_Load()
Load frmWSK
End Sub
Private Sub Form_Unload(Cancel As Integer)
On Error Resume Next
SendData "ServerClosed,"
Pause 500
frmWSK.tcpServer.Close
Dim frm As Form
For Each frm In Forms
Unload frm
Set frm = Nothing
Next
End
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -