-
Notifications
You must be signed in to change notification settings - Fork 0
/
TxtMgr.frm
401 lines (392 loc) · 11.3 KB
/
TxtMgr.frm
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
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"
Object = "{3B7C8863-D78F-101B-B9B5-04021C009402}#1.2#0"; "RICHTX32.OCX"
Begin VB.Form TxtMgr
Caption = "FineReade"
ClientHeight = 8070
ClientLeft = 2670
ClientTop = 2235
ClientWidth = 10170
LinkTopic = "Form1"
ScaleHeight = 8070
ScaleWidth = 10170
Begin VB.Timer tmrLoad
Enabled = 0 'False
Interval = 10
Left = 3120
Top = 0
End
Begin MSComctlLib.ProgressBar prbInfor
Height = 270
Left = 8160
TabIndex = 7
Top = 7800
Width = 2010
_ExtentX = 3545
_ExtentY = 476
_Version = 393216
Appearance = 1
Scrolling = 1
End
Begin MSComctlLib.StatusBar stbInfor
Align = 2 'Align Bottom
DragMode = 1 'Automatic
Height = 360
Left = 0
TabIndex = 6
ToolTipText = "Status Bar"
Top = 7710
Width = 10170
_ExtentX = 17939
_ExtentY = 635
Style = 1
_Version = 393216
BeginProperty Panels {8E3867A5-8586-11D1-B16A-00C0F0283628}
NumPanels = 1
BeginProperty Panel1 {8E3867AB-8586-11D1-B16A-00C0F0283628}
EndProperty
EndProperty
End
Begin RichTextLib.RichTextBox txtFileAsk
Height = 3495
Left = 5160
TabIndex = 5
Top = 4080
Width = 4815
_ExtentX = 8493
_ExtentY = 6165
_Version = 393217
Enabled = -1 'True
ScrollBars = 2
TextRTF = $"TxtMgr.frx":0000
End
Begin RichTextLib.RichTextBox txtFileUnc
Height = 3495
Left = 120
TabIndex = 4
Top = 4080
Width = 4815
_ExtentX = 8493
_ExtentY = 6165
_Version = 393217
ScrollBars = 2
MousePointer = 99
TextRTF = $"TxtMgr.frx":0084
End
Begin RichTextLib.RichTextBox txtFile
Height = 3135
Left = 120
TabIndex = 3
Top = 480
Width = 9855
_ExtentX = 17383
_ExtentY = 5530
_Version = 393217
ScrollBars = 2
TextRTF = $"TxtMgr.frx":0108
End
Begin MSComDlg.CommonDialog dlgfile
Left = 2640
Top = 0
_ExtentX = 847
_ExtentY = 847
_Version = 393216
FilterIndex = 1
Flags = 4100
MaxFileSize = 32000
End
Begin VB.Label Label1
Caption = " Ôîðìàò òåêñòà:"
Height = 255
Left = 120
TabIndex = 2
Top = 120
Width = 1575
End
Begin VB.Label Label3
Caption = " In ASKILL:"
Height = 255
Left = 5160
TabIndex = 1
Top = 3720
Width = 975
End
Begin VB.Label Label2
Caption = " In Unicode:"
Height = 255
Left = 120
TabIndex = 0
Top = 3720
Width = 975
End
Begin VB.Menu File
Caption = "Ôàéë"
Begin VB.Menu New
Caption = "New"
End
Begin VB.Menu Razd
Caption = "-"
End
Begin VB.Menu Open
Caption = "Îòêðûòü"
End
Begin VB.Menu Save
Caption = "Ñîõðàíèòü êàê"
End
Begin VB.Menu Razd1
Caption = "-"
End
End
Begin VB.Menu Pravka
Caption = "Ïðàâêà"
Begin VB.Menu Disk
Caption = "Ñîñòîÿíèå äèñêîâ"
End
Begin VB.Menu Razd2
Caption = "-"
End
Begin VB.Menu Unic
Caption = "Ïåðåâåñòè â Unicode"
End
Begin VB.Menu Askill
Caption = "Ïåðåâåñòè â ASKILL"
End
Begin VB.Menu Dict
Caption = "Àâòîìàòè÷åñêèé ïåðåâîä"
Begin VB.Menu VklDict
Caption = "Âêëþ÷èòü"
End
Begin VB.Menu VklcDict
Caption = "Îòêëþ÷èòü"
End
End
Begin VB.Menu Razd3
Caption = "-"
End
End
Begin VB.Menu Help
Caption = "Ïîìîùü"
End
End
Attribute VB_Name = "TxtMgr"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim mfsysObject As New Scripting.FileSystemObject
Dim strFile As String
Dim bitFileAsk() As Byte
Dim bitFileUnc() As Byte
Dim intCount As Long
Dim blnLoad As Boolean 'ôëàã çàãðóçêè
Dim blnDict As Boolean 'Àâòîìàòè÷åñêèé ïåðåâîä
Dim strFileName As String 'Èìÿ ðàáî÷åãî ôàéëà
Private Sub Askill_Click()
txtFileAsk.Text = ""
' Îòîáðàæàåì â ASKILL
bitFileAsk = StrConv(txtFile.Text, vbFromUnicode)
For intCount = LBound(bitFileAsk) To UBound(bitFileAsk)
txtFileAsk.Text = txtFileAsk.Text & bitFileAsk(intCount) & " "
Next intCount
End Sub
Private Sub Disk_Click()
Disks.Show vbModal
End Sub
Private Sub Form_Resize()
txtFile.Height = TxtMgr.Height / 2 - 1100
txtFile.Width = TxtMgr.Width - 400
txtFileAsk.Height = txtFile.Height
txtFileUnc.Height = txtFile.Height
txtFileAsk.Width = TxtMgr.Width / 2 - 300
txtFileUnc.Width = txtFileAsk.Width
txtFileUnc.Top = txtFile.Height + 1000
txtFileAsk.Top = txtFile.Height + 1000
txtFileAsk.Left = txtFileUnc.Width + 300
Label1.Left = 100
Label2.Left = 100
Label3.Left = txtFileUnc.Width + 300
Label1.Top = 120
Label2.Top = txtFile.Height + 620
Label3.Top = txtFile.Height + 620
prbInfor.Left = TxtMgr.Width - 2100
prbInfor.Top = TxtMgr.Height - 1110
End Sub
Private Sub Open_Click()
txtFile = ""
txtFileAsk = ""
txtFileUnc = ""
' îáúÿâëÿåì îáúåêò òåêñòîâîãî ïîòîêà
Dim tstrOpen As TextStream
' îòêðûâàåì ñòàíäàðòíîå äèàëîãîâîå îêíî
dlgfile.Filter = "Text files(*.txt)|*.txt|Files(*)|*.*|Binary files(*.*)|*.*|Cipher files(*.cph)|*.cph|All files(*.*)|*.*"
dlgfile.DialogTitle = "Îòêðûòü"
dlgfile.ShowOpen
strFileName = dlgfile.FileName
' ïðîâåðÿåì, áûëî ëè óêàçàíî èìÿ ôàéëà
If strFileName = "" Then Exit Sub
' ïðîâåðÿåì, íåò ëè óæå òàêîãî ôàéëà
If Not mfsysObject.FileExists(strFileName) Then
Dim intCreate As Integer
intCreate = MsgBox("File not found. Create it?", vbYesNo)
If intCreate = vbNo Then
Exit Sub
End If
End If
'Óñòàíàâëèâàåìôëàã çàãðóçêè
blnLoad = True
stbInfor.SimpleText = "Çàãðóçêà"
tmrLoad.Enabled = True
' îòêðûâàåì òåêñòîâûé ïîòîê
Set tstrOpen = mfsysObject.OpenTextFile(strFileName, ForReading, True)
DoEvents
' ïðîâåðÿåì, íå íóëåâàÿ ëè äëèíà ó äàííîãî ôàéëà
If tstrOpen.AtEndOfStream Then
' î÷èùàåì òåêñòîâîå ïîëå, íî íè÷åãî íå ñ÷èòûâàåì,
' òàê êàê ó ôàéëà íóëåâàÿ äëèíà
strFile = ""
Else
Select Case dlgfile.FilterIndex
Case 4
'ñ÷èòûâàåì çàøèôðîâàííûé ôàéë
Dim strKey As String
strFile = tstrOpen.ReadAll
'êëþ÷
strKey = Left(strFile, 8)
'äàííûå
strFile = Right(strFile, Len(strFile) - 8)
Dim cipherTest As New Cipher
cipherTest.KeyString = strKey
cipherTest.Text = strFile
cipherTest.DoXor
strFile = Left(cipherTest.Text, Len(cipherTest.Text) - 2)
txtFile.Text = strFile
Case 3
Open strFileName For Binary As #1
Get #1, , strFile
Close #1
txtFile.Text = strFile
Case 1
' ñ÷èòûâàåì è îòîáðàæàåì òåêñòîâûé ïîòîê
strFile = tstrOpen.ReadAll
txtFile.Text = strFile
Case 2
Open strFileName For Input As #1
Line Input #1, strFile
Close #1
txtFile.Text = strFile
Case 5
' ñ÷èòûâàåì è îòîáðàæàåì òåêñòîâûé ïîòîê
strFile = tstrOpen.ReadAll
txtFile.Text = strFile
End Select
End If
' çàêðûâàåì ïîòîê
tstrOpen.Close
'Óñòàíàâëèâàåìôëàã çàãðóçêè
blnLoad = False
stbInfor.SimpleText = ""
tmrLoad.Enabled = False
prbInfor.Value = 0
End Sub
Private Sub New_Click()
txtFileAsk.Text = ""
txtFileUnc.Text = ""
txtFile.Text = ""
End Sub
Private Sub Save_Click()
' îáúÿâëÿåì îáüåêò òåêñòîâîãî ïîòîêà
Dim tstrSave As TextStream
' îòêðûâàåì ñòàíäàðòíîå äèàëîãîâîå îêíî
dlgfile.Filter = "Text files(*.txt)|*.txt|Files(*)|*.*|Binary files(*.*)|*.*|Cipher files(*.cph)|*.cph|All files(*.*)|*.*"
dlgfile.DialogTitle = "Ñîõðàíèòü"
dlgfile.ShowSave
strFileName = dlgfile.FileName
' ïðîâåðÿåì, áûëî ëè óêàçàíî èìÿ ôàéëà
If strFileName = "" Then MsgBox "Íåâåðíîå èìÿ ôàéëà", vbOKOnly, "Information": Exit Sub
' ïðîâåðÿåì, íåò ëè óæå òàêîãî ôàéëà
If mfsysObject.FileExists(strFileName) Then
Dim intOverwrite As Integer
' çàïðàøèâàåì ïîäòâåðæäåíèå íà ïåðåçàïèñü ñóùåñòâóþùåãî ôàéëà
intOverwrite = MsgBox("File already exists. " & "Overwrite it?", vbYesNo)
'åñëè ïîëüçîâàòåëü âûáèðàåò No, âûõîäèì èç ýòîé ïðîöåäóðû
If intOverwrite = vbNo Then
Exit Sub
End If
End If
'Âûáîð âàðèàíòîâ çàïèñè
Select Case dlgfile.FilterIndex
Case 5
' îòêðûâàåì òåêñòîâûé ïîòîê...
Set tstrSave = mfsysObject.OpenTextFile(strFileName, ForWriting, True)
' ñîõðàíÿåì...
tstrSave.Write txtFile.Text
' è çàêðûâàåì
tstrSave.Close
Case 1
' îòêðûâàåì òåêñòîâûé ïîòîê...
Set tstrSave = mfsysObject.OpenTextFile(strFileName, ForWriting, True)
' ñîõðàíÿåì...
tstrSave.Write txtFile.Text
' è çàêðûâàåì
tstrSave.Close
Case 2
Open strFileName For Output As #1
Print #1, txtFile.Text
Close #1
Case 3
'Ñîõðàíÿåò äâîè÷íûé ôàéë
Open strFileName For Binary As #1
Put #1, , txtFile.Text
Close #1
Case 4
Dim cipherTest As New Cipher
'Çàïðîñ êëþ÷à
EnterKey.Show vbModal
'Øèôðîâêà
cipherTest.KeyString = EnterKey.txtKey
cipherTest.Text = txtFile.Text
cipherTest.DoXor
'Çàïèñü ïåðâûå 8 ñèìâîëîâ - êëþ÷
Open strFileName For Output As #1
Print #1, EnterKey.txtKey & cipherTest.Text
Close #1
End Select
End Sub
Private Sub tmrLoad_Timer()
DoEvents
prbInfor.Value = Len(strFile) / FileLen(strFileName) * 100
End Sub
Private Sub txtFile_Change()
If blnDict Then
txtFileUnc.Text = ""
txtFileAsk.Text = ""
' Îòîáðàæàåì â ASKILL
bitFileAsk = StrConv(txtFile.Text, vbFromUnicode)
For intCount = LBound(bitFileAsk) To UBound(bitFileAsk)
txtFileAsk.Text = txtFileAsk.Text & bitFileAsk(intCount) & " "
Next intCount
'Îòîáðàæàåì â Unicode
bitFileUnc = txtFile.Text
For intCount = LBound(bitFileUnc) To UBound(bitFileUnc)
txtFileUnc.Text = txtFileUnc.Text & bitFileUnc(intCount) & " "
Next intCount
Else
Exit Sub
End If
End Sub
Private Sub Unic_Click()
txtFileUnc.Text = ""
'Îòîáðàæàåì â Unicode
bitFileUnc = txtFile.Text
For intCount = LBound(bitFileUnc) To UBound(bitFileUnc)
txtFileUnc.Text = txtFileUnc.Text & bitFileUnc(intCount) & " "
Next intCount
End Sub
Private Sub VklcDict_Click()
blnDict = False
End Sub
Private Sub VklDict_Click()
blnDict = True
End Sub