This repository was archived by the owner on Oct 11, 2022. It is now read-only.
forked from nickelsworth/swag
-
Notifications
You must be signed in to change notification settings - Fork 0
Expand file tree
/
Copy path0062.pas
More file actions
326 lines (312 loc) · 10.6 KB
/
Copy path0062.pas
File metadata and controls
326 lines (312 loc) · 10.6 KB
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
{
> Is there out there that has any good encription code.. something like rsa?
{****************************************************************************}
{ Unit to Compute in a Very Pascal Way }
{****************************************************************************}
{ Incredible File Utilities }
{****************************************************************************}
{ Version : 1.0 Dec 1990 }
{****************************************************************************}
Unit FileUtil ;
{****************************************************************************}
Interface uses dos ;
{****************************************************************************}
Const
Crea = 'UNIT FILEUTIL.TPU V.1.0 By: Jeffrey N. Thompson' ;
Creat = '(C) Copywrite 1990,1991 By KJE Software Opportunities
Exclusively' ;{ Procedure and function List }
Function FileExists(pathname:string):boolean ;
function KillFile(pathname : string):boolean ;
Procedure cryptB(var Rec ; size : word ; Sym : Byte) ;
Procedure CryptStr(var Rec ; Size : Word ; Ecrypt : string) ;
Procedure CryptS(Var Rec ; Size : Word ; Seed : longint) ;
Function CryptfileStr(Fname:string; Ecrypt : string) : integer ;
Function CryptfileWithFile(Fname,Keyname : String) : Integer ;
Function CryptFileS(Fname : string ; Seed : longint) : integer ;
{****************************************************************************}
Implementation { Uses }
{ Procedures and functions follow }
{****************************************************************************}
{ Check if a filename Exists in the current drive and directory. }
Function FileExists(pathname : string) : boolean ;
Var
search : searchrec ;
exists : boolean ;
Begin { Exists }
exists := false ;
findfirst(pathname,anyfile,search) ;
exists := (doserror = 0) and (search.name <> '') ;
fileexists := exists ;
End ; { Exists }
{****************************************************************************}
{ Destroys a file. Unrecoverably }
function KillFile(pathname : string):boolean ;
var
kfile : file ;
buffer : array[1..2048] of byte ;
numread,numwritten : word ;
I : integer ;
j2 : longint ;
found : boolean ;
begin
{$F-}
if fileexists(pathname) then
begin
found := true ;
assign(kfile,pathname) ;
setfattr(kfile,0) ;
reset(kfile,1) ;
repeat
Blockread(kfile,buffer,sizeof(buffer),numread) ;
j2 := filepos(kfile) ;
for I := 1 to numread do buffer[i] := random(255) ;
seek(kfile,j2-numread) ;
blockwrite(kfile,buffer,numread,numwritten) ;
seek(kfile,j2) ;
until (numread = 0) or (numwritten <> numread) ;
close(kfile) ;
erase(kfile) ;
end else found := false ;
{$F+}
killfile := (ioresult=0) and (found) ;
end ;
{****************************************************************************}
{ Encrypt a record of SIZE with a Byte Sized SYMbol }
procedure cryptb(var Rec ; size : word ; Sym : Byte) ;
type
buffers = array[1..65535] of byte ;
var
I : word ;
buffer : ^buffers ;
begin
buffer := nil ;
buffer := @rec ;
for I := 1 to size do buffer^[I] := buffer^[i] xor sym ;
end ;
{****************************************************************************}
{ Encrypts a record of SIZE with a Sliding String method }
procedure CryptStr(var Rec ; Size : Word ; Ecrypt : string) ;
type
buffers = array[1..65535] of byte ;
var
I,J : word ;
buffer : ^buffers ;
l : integer ;
c1 : char ;
begin
l := length(ecrypt) ;
if l = 1 then
begin
c1 := ecrypt[1] ;
cryptb(rec,size,byte(c1)) ;
exit ;
end ;
if l<2 then exit ;
buffer := nil ;
buffer := @rec ;
j := 1 ;
for I := 1 to size do
begin
buffer^[I] := buffer^[i] xor byte(ecrypt[j]) ;
inc(j) ;
if j > l then
begin
j := 1 ;
c1 := ecrypt[1] ;
move(ecrypt[2],ecrypt[1],l-1) ;
ecrypt[l] := c1 ;
end ;
end ;
end ;
{****************************************************************************}
{ Encrypts a record of SIZE with a list of random numbers produced by
Initial Seeding with SEED }
procedure cryptS(var Rec ; size : word ; Seed : longint) ;
type
buffers = array[1..65535] of byte ;
var
I : word ;
buffer : ^buffers ;
begin
randseed := seed ;
buffer := nil ;
buffer := @rec ;
for I := 1 to size do buffer^[I] := buffer^[i] xor byte(random(254)+1) ;
end ;
{****************************************************************************}
{ Encrypts a file, with a string using a sliding string method }
{ String em up! }
function CryptfileStr(Fname:string; Ecrypt : string) : integer ;
const
tempfilename = 'KJETLHM.DS2' ;
var
fromfile,tofile : file ;
buffer : array[1..2048] of byte ;
numread,numwritten,attr : word ;
error : boolean ;
I,J,L : integer ;
j2 : longint ;
c1 : char ;
begin
if not fileexists(fname) then
begin
cryptfileStr := 1 ;
exit ;
end ;
if length(ecrypt) <= 1 then
begin
cryptfileStr := 2 ;
exit ;
end ;
l := length(ecrypt) ;
{$I-}
assign(fromfile,fname) ;
assign(tofile,tempfilename) ;
getfattr(fromfile,attr) ;
setfattr(fromfile,0) ;
reset(fromfile,1) ;
rewrite(tofile,1) ;
repeat
blockread(fromfile,buffer,sizeof(buffer),numread) ;
j := 1 ;
for I := 1 to sizeof(buffer) do
begin
buffer[I] := buffer[I] xor byte(ecrypt[j]) ;
inc(j) ;
if j > l then
begin
j := 1 ;
c1 := ecrypt[1] ;
move(ecrypt[2],ecrypt[1],l-1) ;
ecrypt[l] := c1 ;
end ;
end ;
blockwrite(tofile,buffer,numread,numwritten) ;
until (numread = 0) or (numwritten <> numread) ;
close(tofile) ;
close(fromfile) ;
error := killfile(fname) ;
rename(tofile,fname) ;
setfattr(tofile,attr) ;
{$I+}
cryptfileStr := (IOresult)
end ;
{****************************************************************************}
{ encrypts a file with another file as the key, using a sliding method
}
{ File this sucker! }
Function CryptfileWithFile(Fname,Keyname : String) : Integer ;
const
Tempfilename = 'KJETLHM.DS3' ;
var
Infile,Keyfile,Outfile : file ;
Bfile : File of Byte ;
inBuffer,keybuffer,outbuffer : array[1..2048] of byte ;
attr,kattr : word ;
I,J : longint ;
numread,numwritten,numkread : word ;
error : boolean ;
begin
if not fileexists(fname) then
begin
cryptfilewithfile := 1 ;
exit ;
end ;
if not fileexists(keyname) then
begin
cryptfilewithfile := 2 ;
exit ;
end ;
{$I-}
Assign(infile,fname) ;
assign(keyfile,keyname) ;
assign(outfile,tempfilename) ;
getfattr(infile,attr) ;
getfattr(keyfile,kattr) ;
setfattr(infile,0) ;
setfattr(keyfile,0) ;
reset(infile,1) ;
reset(keyfile,1) ;
rewrite(outfile,1) ;
repeat
{ Fill the input buffer }
blockread(infile,inbuffer,sizeof(inbuffer),numread) ;
{ Fill the key buffer }
blockread(keyfile,keybuffer,sizeof(keybuffer),numkread) ;
j := numkread ;
if numkread < numread then { The Keyfile is smaller }
repeat { Keep resetting and reading until the buffer is full }
reset(keyfile,1) ;
blockread(keyfile,keybuffer[j+1],numread-j,numkread) ;
j := j + numkread ;
if j > numread then HALT(3) ;
until j = numread ;
for I := 1 to numread do
outbuffer[I] := inbuffer[I] XOR keybuffer[I] ;
blockwrite(outfile,outbuffer,numread,numwritten) ;
until (numread = 0) or (numwritten <> numread) ;
close(keyfile) ;
setfattr(keyfile,kattr) ; { Restore the attributes }
close(infile) ;
close(outfile) ;
{ Now destroy the old file }
error := killfile(fname) ;
rename(outfile,fname) ;
setfattr(outfile,attr) ;
{$I+}
cryptfilewithfile := IoResult ;
end ;
{****************************************************************************}
{ Encrypts a file, using a list of random numbers generated with an
initial SEED. The Seed is your key }
function CryptfileS(Fname:string; Seed : Longint) : integer ;
const
tempfilename = 'KJETLHM.DS4' ;
var
fromfile,tofile : file ;
buffer : array[1..2048] of byte ;
numread,numwritten,attr : word ;
I : integer ;
error : boolean ;
begin
if not fileexists(fname) then
begin
cryptfileS := 1 ;
exit ;
end ;
randseed := seed ;
{$I-}
assign(fromfile,fname) ;
assign(tofile,tempfilename) ;
getfattr(fromfile,attr) ;
setfattr(fromfile,0) ;
reset(fromfile,1) ;
rewrite(tofile,1) ;
repeat
blockread(fromfile,buffer,sizeof(buffer),numread) ;
for I := 1 to numread do
buffer[I] := buffer[I] xor byte(random(254)+1) ;
blockwrite(tofile,buffer,numread,numwritten) ;
until (numread = 0) or (numwritten <> numread) ;
close(tofile) ;
close(fromfile) ;
error := killfile(fname);
rename(tofile,fname) ;
setfattr(tofile,attr) ;
{$I+}
cryptfileS := IOresult ;
end ;
{****************************************************************************}
{****************************************************************************}
end. { Unit }
{
These are not weird math methods of encryption. They are simple
Extreemly fast XOR methods. By using multiple methods on various parts
of a file, or database, you can foil any attempt at cracking. This is
true because the cracker has no way of knowing where to start, even if
he possesses the keys..
I have a standing challenge, if anyone cares to take it... Here
are the methods, I'll post a small file, and even give you the keys I
used to ecrypt a simple one line sentence. If you can crack it, I'll
buy you a pentium computer!
}