{$A+,B-,D-,E-,F-,G+,I+,L+,N+,O-,P-,Q-,R-,S+,T-,V+,X+,Y+}
{$M 16384,0,655360}
Program JFIF_JPG_Extractor;
{Shyar Compiler 18/10/2003 v3.25 SHURIK}
Uses CRT, DOS;
const
Search : String[11] = #$FF#$D8#$FF#$E0#$00#$10#$4A#$46#$49#$46#$00;
GIF : String[7] = #$47#$49#$46#$00#$38#$39#$61;
type
PData = ^TData;
TData = array[1..65535] of Char;
type
TLFNData = record
FAttrib : Longint;
MakeTime : array[0..7] of Byte;
LastAccessTime : array[0..7] of Byte;
LastModifTime : array[0..7] of Byte;
HiFileSize, LoFileSize : Longint;
Reserv : array[0..7] of Byte;
LongFileName : array[0..259] of Char;
ShortFileName : array[0..13] of Char;
end;
var
FN : String;
CurDir : String;
Nst : NameStr;
Dst : DirStr;
Est : ExtStr;
B : Byte;
Ps, Sz, m : Longint;
Mem : array[1..300] of Longint;
f, ff : file;
i, Z, k : Word;
CountFiles : Word;
Data : PData;
S : String;
FNZ : array[0..255] of Char;
LFNData : TLFNData;
Srch : SearchRec;
Srch1 : SearchRec;
Stop : Boolean;
NoPause : Boolean;
NoError : Boolean;
Procedure DoHelp;
begin
WriteLn('`JPEG/JPG Extractor/DOS version/v3.25`');
WriteLn('===== Информация о программе: =======');
WriteLn('Программа для извлечения JPEG/JPG - файлов.');
WriteLn('Не забывайте, что программа не понимает длинных имён Windows!');
WriteLn('Поэтому в командной строке необходимо указывать короткое имя файла-источника');
WriteLn('Если не знаете DOS-имя файла, Вы можете его легко определить в Windows:');
WriteLn('Например: Мой компьютер>/../путь/../>Имя файла>Свойства>Имя DOS.');
WriteLn('Обычно DOS-имя легко определить, если знать, как оно генерируется.');
WriteLn('Если Windows-имя длиннее 8 символов, то оно сокращается до 8 следующим');
WriteLn('образом: запрещённые символы заменяются символом подчёркивания,');
WriteLn('пробелы убираются, в конце имени файла ставится тильда, после неё - ');
WriteLn('цифра(1 - если файлов с таким именем нет, 2, 3, ... - если есть).');
WriteLn('Например: DANCIN~1.SCR');
WriteLn('ТЕПЕРЬ ПОДДЕРЖИВАЕТСЯ РАБОТА С МАСКАМИ! (Т.Е. ВИДА "*.*")');
WriteLn('Формат обращения:');
WriteLn('jje [/?] <маска им.-ф.-источ.> [нач.-4-симв.-имён-.jpg-файлов или /NP[E]]');
WriteLn('Ключи /?, /h, /help - вызов справки; /NP[E] - откл. паузы [и ошибки]');
WriteLn('Параметр "начальные-4-символа-имён-.jpg-файлов" может содержать и больше');
WriteLn('и меньше 4-х символов; в случае отсутствия этого параметра имя .jpg-файла');
WriteLn('определяется по имени файла - источника.');
WriteLn('Если второй параметр содержит больше 4 символов, то берутся первые четыре');
WriteLn('Примеры:');
WriteLn('jje teddib~1.dat');
WriteLn('jje Valent~1.msf valn');
Write('jje autumn~1.scr autm');
ReadKey;
WriteLn;
end;
Function FindLFNFile(var Buff) : Word; Assembler;
asm
mov cl, 11110111b
mov ch, 11110111b
mov si, 0
push ds
push es
mov ax, seg FNZ
mov ds, ax
mov dx, offset FNZ
mov ax, seg Buff
mov es, ax
mov di, offset Buff
mov ax, 714Eh
int 21h
pop es
pop ds
end;
Function UpString(Sra : String) : String;
var
i : Byte;
Sr : String;
begin
Sr := Sra;
for i := 1 to Length(Sr) do
Sr[i] := UpCase(Sr[i]);
UpString := Sr
end;
Function FindStr : Word;
var
j : Longint;
N : Word;
Function Equal : Boolean;
var
w : Word;
Equ : Boolean;
begin
Equ := True;
for w := j-10 to j do
Equ := Equ and (Data^[w] = Search[w+11-j]);
Equal := Equ;
end;
begin
N := 0;
While k = SizeOf(TData) do
begin
j := 11;
While j <= SizeOf(TData) do
begin
if Equal then
begin
inc(N);
Mem[N] := Ps+j-12;
WriteLn('Позиция: ', Mem[N]+1, '; Найдено: ', N, ' ');
end;
inc(j);
end;
inc(Ps, 65500);
if Ps>FileSize(f) then Ps := FileSize(f)-SizeOf(TData)-1;
{$I-}
Seek(f, Ps);
BlockRead(f, Data^, SizeOf(TData), k);
{$I+}
end;
j := 11;
While j <= SizeOf(TData) do
begin
if Equal then
begin
inc(N);
Mem[N] := Ps+j-12;
WriteLn('V Позиция: ', Ps+j-12, '; Найдено: ', N, ' ');
end;
inc(j);
end;
FindStr := N;
end;
{----------------}
Procedure PutChr(C:Char;Col : Byte);Assembler;
asm
mov ah, $09
mov bh, 0
mov bl, Byte Ptr Col
mov al, Byte ptr C
mov cx, 1
int $10
end;
{----------------}
Procedure FindExtract(FNm1 : String);
var
FNm : String;
begin
if KeyPressed then if ReadKey=#27 then Stop := True;
FNm := FNm1;
for i := 0 to Length(FNm) do
FNZ[i] := FNm[i+1];
FNZ[Length(FNm)]:=#0;
for i := 0 to Length(FNm) do
Write(FNZ[i]);
WriteLn;
WriteLn('!=> ', FindLFNFile(LFNData));
for i := 0 to 13 do
Write(LFNData.ShortFileName[i]);
WriteLn;
WriteLn(LFNData.ShortFileName, ' ', LFNData.HiFileSize, LFNData.LoFileSize);
if not NoPause then if ReadKey=#27 then
begin
Stop := True;
Exit;
end;
{$I-}
Assign(f, Dst+FNm);
Reset(f, 1);
{$I+}
if IOResult <> 0 then
begin
WriteLn('Ошибка чтения файла "', FNm, '" (файл не найден)');
if not NoError then ReadKey;
Exit;
end;
WriteLn('Обрабатывается файл '+FNm+'...');
Ps := FilePos(f);
if MaxAvail>=SizeOf(TData)
then
GetMem(Data, 65535)
else
begin
WriteLn('Ошибка: нехватка памяти < ', MaxAvail,' байт >, нужно - ', SizeOf(TData));
if not NoError then ReadKey;
Exit;
end;
FillChar(Data^, 65535, 0);
if ParamCount >= 2 then
if not NoPause then
begin
FNm := ParamStr(2);
if Length(FNm)<4 then FNm:=FNm+FNm+FNm+FNm;
end;
{$I-}
BlockRead(f, Data^, SizeOf(TData), k);
{$I+}
Z := FindStr;
WriteLn('Искомая строка - "', Search, '";');
for i := 1 to Z do
begin
{$I-}
if Mem[i] 0 then WriteLn('Создание JPG-файлов...');
for i := 1 to Z do
begin
{$I-}
Seek(f, Mem[i]+1);
Str(CountFiles, S);
{$I+}
inc(CountFiles);
Repeat
if Length(S)>4 then S := S[1]+S[2]+S[3]+S[4];
S := FNm[1]+FNm[2]+FNm[3]+FNm[4] + S + '.JPG';
FindFirst(Dst+S, AnyFile, Srch1);
if Srch1.Name=S then
begin
WriteLn('---=== Внимание! Найден файл с одинаковым именем! ===--- | ', S);
Repeat
Write('Введите комбинацию символов для генерации другого имени: ');
ReadLn(FNm);
Until FNm<>'';
if Length(FNm)<4 then FNm := FNm+FNm+FNm+FNm;
While Pos(' ', FNm)<>0 do
begin
Delete(FNm, Pos(' ', FNm), 1);
end;
end;
Until Srch1.Name<>S;
Assign(ff, dst+S);
{$I-}
Rewrite(ff, 1);
{$I+}
if i <> Z then
Sz := Mem[i+1]-Mem[i]+1
else
Sz := FileSize(f)-(1+Mem[i]);
WriteLn('Файл ', S, ' размером ', Sz, ' байт, номер ', CountFiles);
m := 1;
While m < Sz do
begin
{$I-}
if Sz-m >= 65535 then
BlockRead(f, Data^, 65535)
else
BlockRead(f, Data^, Sz-m+1);
{$I+}
if IOResult <> 0 then
begin
WriteLn('Ошибка чтения файла-источника с диска!');
{$I-}
Close(f);
{$I+}
if FileSize(ff)=0 then BlockWrite(ff, Data^, Sz-m+1);
{$I-}
Close(ff);
{$I+}
if not NoError then ReadKey;
Exit;
end;
{$I-}
if Sz-m >= 65535 then
BlockWrite(ff, Data^, 65535)
else
BlockWrite(ff, Data^, Sz-m+1);
{$I+}
if IOResult <> 0 then
WriteLn('Ошибка создания/записи в файл ', S);
m := m + 65535;
end;
{$I-}
Close(ff);
{$I+}
end;
FreeMem(Data, SizeOf(TData));
Close(f);
end;
begin
if ParamCount = 0 then
begin
WriteLn('Отсутствует маска имени файлов - введите её в командной строке');
ReadKey;
DoHelp;
Halt($FFFF);
end;
CountFiles := 0;
FN := ParamStr(1);
FSplit(FN, Dst, Nst, Est);
if (FN='/?') or (UpString(FN)='/H') or (UpString(FN)='/HELP')
then
begin
DoHelp;
Halt(Word(Byte('H')+Byte('h')*$100));
end;
NoError := False;
NoPause := False;
Stop := False;
if UPSTRING(ParamStr(2))='/NP' then NoPause := True;
if UPSTRING(ParamStr(2))='/NPE' then
begin
NoPause := True;
NoError := True;
end;
ClrScr;
FindFirst(FN, $27, Srch);
While DOSError = 0 do
begin
if Pos('.JPG', UpString(Srch.Name))= 0 then
begin
WriteLn('___________________________________');
FindExtract(Srch.NAME);
end;
if Stop then Break;
FindNext(Srch);
end;
WriteLn('[========-----+++++-----========]');
WriteLn('Всего найдено файлов: ', CountFiles);
end.
< -->