Главная страница
    Top.Mail.Ru    Яндекс.Метрика
Форум: "Основная";
Текущий архив: 2002.08.26;
Скачать: [xml.tar.bz2];

Вниз

Подскажите, где я ошибся?   Найти похожие ветки 

 
Explorer   (2002-08-15 12:41) [0]

Мастера!
Написал программку, которая копирует определенные файлы.
Но... почему то, не хочет копировать файл с именем "insur.*".
расширение у всех файлов " *.565(любые три цифры, зависит от даты)"
Может подскажите?
Вот код:

program auto;
{$APPTYPE CONSOLE}

uses
SysUtils, Windows, RXShell;

var inpath,in1path,preppath,progpath,self,s,s1,apppath:string;
a,b:array[1..200] of string;
n:integer;

function CheckName(s:string):boolean;
begin
s:=lowercase(s);
if (length(s)<>12) or (pos(".",s)=0) then begin
Result:=false;
exit;
end;
Result:=true;
if pos("onlnef",s)=1 then exit;
if pos("balsup",s)=1 then exit;

if pos("insur",s)=1 then exit; // вот этот файл не копирует!!!

if pos("questn",s)=1 then exit;

if (pos("onln",s)=1) and (s[6]="t") then exit;
if (pos("cgbr",s)=1) and (s[6]="s") then exit;
s:=copy(s,pos(".",s)+1,3);
if s="arj" then exit;
if s="zip" then exit;
if s="rar" then exit;
Result:=false;
end;

function Locate(s:string):integer;
var i:integer;
begin
Result:=0;
for i:=1 to n do if a[i]=s then begin Result:=i; exit; end;
end;

procedure CheckIn;
var z:TSearchRec;
p:integer;
g:textfile;
begin
if FindFirst(inpath+"*.*",faAnyFile-faDirectory-faVolumeID,Z)=0 then
repeat
if Checkname(z.name) then
begin
p:=Locate(copy(z.name,7,2));
if p<>0 then
begin
assignfile(g,apppath+"list.tmp");
rewrite(g);
writeln(g,b[p]);
closefile(g);
FileExecuteWait(progpath," -SA -u "+inpath+z.name+" -n"+apppath+"list.tmp -p"+apppath+"\log.txt",ExtractFileDir(progpath),esNormal);
FileExecuteWait(progpath," -SA -d "+in1path+z.name+" -p"+apppath+"\log.txt",ExtractFileDir(progpath),esNormal);
end;
end;
until Findnext(z)<>0;
SysUtils.FindClose(Z);
end;

procedure CheckOut;
var z:TSearchRec;
p:integer;
g:textfile;
begin
if FindFirst(preppath+"*.*",faAnyFile-faDirectory-faVolumeID,Z)=0 then
repeat
if Checkname(z.name) then
begin
p:=Locate(copy(z.name,7,2));
if p<>0 then
begin
assignfile(g,apppath+"list1.tmp");
rewrite(g);
writeln(g,b[p]);
writeln(g,self);
closefile(g);
FileExecuteWait(progpath," -SA -b "+preppath+z.name+" -n"+apppath+"list1.tmp -p"+apppath+"\log1.txt",ExtractFileDir(progpath),esNormal);
end;
end;
until Findnext(z)<>0;
SysUtils.FindClose(Z);
end;

procedure Init;
var f:textfile;
begin
assignfile(f,apppath+"paths.cfg");
reset(f);
readln(f,progpath);
readln(f,inpath);
readln(f,in1path);
readln(f,preppath);
closefile(f);
assignfile(f,apppath+"filials.cfg");
reset(f);
while not SeekEof(f) do
begin
readln(f,s);
s1:=copy(s,1,2);
if s1="--" then continue;
delete(s,1,3);
if s1="-1" then self:=s
else
begin
inc(n);
a[n]:=s1;
b[n]:=s;
end;
end;
closefile(f);
end;

begin
apppath:="C:\autocrp\";
Init;
CheckIn;
CheckOut;
end.


 
McSimm   (2002-08-15 12:48) [1]


> if (length(s)<>12)

Думаю проблема здесь


 
Explorer   (2002-08-15 13:11) [2]

не помогло...


 
McSimm   (2002-08-15 13:13) [3]

Подробнее. Как именно проявляется проблема?


 
McSimm   (2002-08-15 13:29) [4]

Трудно разобраться в логике программы.

Вот еще спорный момент:

> p:=Locate(copy(z.name,7,2));

Почему 7 ?


 
Slym   (2002-08-16 06:50) [5]

Я с таким сталкивался... не хотел открывать некоторые файлы...
Перейди с Pascal"евских операторов на WinAPI:
assign, reset -> CreateFile

procedure Init;
var
f:longint;
fn:string;
buf:pChar;
readen,p:dword;
begin
fn:=apppath+"paths.cfg"+#0;
f:=CreateFile(fn,GENERIC_READ,FILE_SHARE_READ,nil,OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL,nil);
if f<>Invalid_handle_value then
begin
getmem(buf,1024);
readFile(f,buf,1023,readen,nil)
//чтото в этом духе
p:=pos(chr(13),buf);
progpath:=copy(buf,1,p);
delete(buf,1,p);
//..скоко надо стоко и читаешь
CloseHandle(f);
end;



Страницы: 1 вся ветка

Форум: "Основная";
Текущий архив: 2002.08.26;
Скачать: [xml.tar.bz2];

Наверх





Память: 0.46 MB
Время: 0.006 c
14-85250
Владик_1
2002-08-02 09:43
2002.08.26
Nt4. Планировщик заданий. Нет?


6-85145
Timon
2002-05-27 14:38
2002.08.26
Опрос DNS


4-85284
Dmk
2002-06-19 01:48
2002.08.26
Как избавиться от мерцания?


14-85238
Anna_
2002-07-30 18:09
2002.08.26
Встречи


1-85017
MikeFW
2002-08-15 17:40
2002.08.26
Требуется помощь (Word c Delphi)...





Afrikaans Albanian Arabic Armenian Azerbaijani Basque Belarusian Bulgarian Catalan Chinese (Simplified) Chinese (Traditional) Croatian Czech Danish Dutch English Estonian Filipino Finnish French
Galician Georgian German Greek Haitian Creole Hebrew Hindi Hungarian Icelandic Indonesian Irish Italian Japanese Korean Latvian Lithuanian Macedonian Malay Maltese Norwegian
Persian Polish Portuguese Romanian Russian Serbian Slovak Slovenian Spanish Swahili Swedish Thai Turkish Ukrainian Urdu Vietnamese Welsh Yiddish Bengali Bosnian
Cebuano Esperanto Gujarati Hausa Hmong Igbo Javanese Kannada Khmer Lao Latin Maori Marathi Mongolian Nepali Punjabi Somali Tamil Telugu Yoruba
Zulu
Английский Французский Немецкий Итальянский Португальский Русский Испанский