module1.bas

加密文本编辑器 VB

Attribute VB_Name = "Module1"
Public mbackcolor As Long
Public mforecolor As Long
Public mfontsize As Integer
Public mfontname As String
Public mtop As Integer
Public mleft As Integer
Public mheight As Integer
Public mwidth As Integer

Public dirty As Integer
Public filename As String
Public Const myName = "加密文本编辑器"

Public strnum As Integer
Public code As Integer
Public intForm, intTo As Integer
Public cancle As Boolean
Public findtext As String
Public dx, fx, gfristTime As Integer
Public intPos As Integer
Public intstart As Integer
Public gCurPos As Integer

Public IntType As Integer
Public Seed(1 To 24) As Integer
Public Seedlong As Integer
Public Type codeflag
BEenter As Boolean
BKong As Boolean
End Type
Public pass As codeflag
Public Declare Function SetWindowPos Lib "user32" (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, ByVal x As Long, ByVal y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long
Public Sub openfile()
      
      Form1.Text1.Text = (Empty)
    If filename = "" Or filename = "无名" Then getFileName

     If toobig = True Then Exit Sub
     whr$ = Chr$(13) & Chr$(10)
     On Error GoTo 1
     Open filename For Input As #1
     
       Form1.MousePointer = 1
     Form1.Text1.Text = StrConv(InputB(LOF(1), 1), vbUnicode)
     Close #1
     dirty = False
     
1:     Exit Sub


End Sub
Public Sub getFileName()
     If dirty = True Then
s = MsgBox(filename & "文件未保存" & Chr$(13) & "保存吗?", vbYesNoCancel, "未保存")
Select Case s
Case vbYes
SaveFile
GoTo love
Case vbNo
GoTo love
Case vbCancel
Exit Sub
End Select
End If
love:
toobig = False
Form1.Dialog1.Filter = "纯文本文件(*.txt)|*.txt|所有文件(*.*)|*.*|"
  Form1.Dialog1.ShowOpen
If Form1.Dialog1.filename = "" Then Exit Sub
        On Error GoTo nofile
        If FileLen(Form1.Dialog1.filename) > 65000 Then
            MsgBox "文件太大，无法打开！", , "出错"
            toobig = True
           Exit Sub
        End If
filename = ""
filename = Form1.Dialog1.filename
Exit Sub
nofile:
MsgBox "文件出错，无法打开！", , "出错"
filename = ""
toobig = False
Exit Sub
End Sub
Public Sub setFileName()
On Error Resume Next
Form1.Dialog1.Filter = "纯文本文件(*.txt)|*.txt|所有文件(*.*)|*.*|"
  Form1.Dialog1.ShowSave
  cancle = False
    If Form1.Dialog1.filename = "" Then Exit Sub
  filename = Form1.Dialog1.filename
Exit Sub

End Sub
Public Sub SaveFile()
If filename = "" Or filename = "无名" Then
setFileName
End If
If filename = "" Or filename = "无名" Then
Exit Sub
End If
Form1.MousePointer = 11
mytext = Form1.Text1.Text
On Error GoTo bye
Open filename For Output As #1
Print #1, mytext
Close #1
Form1.Caption = myName & "-" & filename
bye:
Form1.MousePointer = 1
dirty = False
Exit Sub
End Sub
Public Sub CopyIt()
    Clipboard.SetText Form1.Text1.SelText
End Sub

Public Sub CutIt()
    Clipboard.SetText Form1.Text1.SelText
    Form1.Text1.SelText = ""
End Sub

Public Sub PasteIt()
    Form1.Text1.SelText = Clipboard.GetText()
End Sub
Public Sub selectall()
    Form1.Text1.SelStart = 0
    Form1.Text1.SelLength = Len(Form1.Text1.Text)

End Sub
Public Sub NewFile()
     If dirty = True Then
s = MsgBox(filename & "文件未保存" & Chr$(13) & "保存吗?", vbYesNoCancel, "未保存")
Select Case s
Case vbYes
SaveFile
GoTo love
Case vbNo
GoTo love
Case vbCancel
Exit Sub
End Select
End If
love:
filename = "无名"
mytext = ""
Form1.Text1.Text = ""
dirty = False
code = 0
Form1.Caption = myName & "-" & filename
End Sub

Public Sub FindIt()
    Dim strSourceString As String

    Dim intResponse As Integer
    Dim intOffset As Integer
    Dim strFindString As String
    If (gCurPos = Form1.Text1.SelStart) Then
        intOffset = 1
    Else
        intOffset = 0
    End If
     If gfirsttime = True Then intOffset = 0
     intstart = Form1.Text1.SelStart + intOffset
        
     
    If dx = 0 Then
        strFindString = findtext
        strSourceString = Form1.Text1.Text
    Else
        strFindString = UCase(findtext)
        strSourceString = UCase(Form1.Text1.Text)
    End If
    If fx = 1 Then
    intPos = InStr(intstart + 1, strSourceString, strFindString)
    Else
        For intPos = intstart - 1 To 0 Step -1
            If intPos = 0 Then Exit For
            If Mid(strSourceString, intPos, Len(findtext)) = findtext Then Exit For
        Next
    End If

    If intPos Then
        Form1.Text1.SelStart = intPos - 1
        Form1.Text1.SelLength = Len(findtext)
    Else
     Form2.Hide
        intResponse = MsgBox("找不到", 0, App.Title)
     Form2.Show
    End If
    
    gCurPos = Form1.Text1.SelStart
    End Sub
Public Sub tihuanIt()
FindIt
If Form1.Text1.Text = "" Then GoTo vv
On Error GoTo vv
Form1.Text1.SelText = Form2.Text2.Text
Form1.Text1.SelStart = intPos - 1
Form1.Text1.SelLength = Len(Form2.Text2.Text)
vv: Exit Sub
End Sub



'----------
'- 密码   -
'----------
Public Sub getseed(password)
Seedlong = Len(password)
For i = 1 To Seedlong
Seed(i) = Asc(Mid(password, i, 1)) Xor i
Next i
If Form3.CheEnter.Value = 1 Then pass.BEenter = True Else pass.BEenter = False
If Form3.CheKong.Value = 1 Then pass.BEenter = True Else pass.BKong = False

End Sub

Public Sub mi()
temp = ""
Dim intlen
Dim latter
intForm = intForm + 1
intTo = intTo + 1
intlen = Len(Form1.Text1)
z1 = Mid(Form1.Text1.Text, 1, intForm - 1)
z2 = Mid(Form1.Text1.Text, intForm, intTo - intForm)
z3 = Mid(Form1.Text1.Text, intTo + 1, intlen)
a = Len(z2)
For i = 0 To a Step Seedlong
For j = 1 To Seedlong
On Error GoTo c
latter = Asc(Mid(z2, i + j, 1))
If latter = 32 And pass.BEenter = True Then GoTo b Else GoTo a
If latter = 13 And pass.BKong = True Then GoTo b Else GoTo a
a: latter = Seed(j) Xor Asc(Mid(z2, i + j, 1))
b: temp = temp & Chr(latter)
Next j
c: Next i

Form1.Text1.Text = z1 & temp & z3
End Sub