Главная страница
    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.008 c
14-85164
Mihail
2002-07-29 13:27
2002.08.26
Мастера, ПОМОГИТЕ, не могу установить.


6-85147
Cyrex
2002-04-28 15:44
2002.08.26
Где можно найти описание Internet Component Suite на русском?


1-85057
MMMax
2002-08-14 13:38
2002.08.26
F1Book версия: 6.1.5


6-85162
Nikollay
2002-06-14 19:49
2002.08.26
Как отловить ClientSocket1->Open() ???


1-84977
minva
2002-08-15 16:59
2002.08.26
Компоненты с исходным кодом





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
Английский Французский Немецкий Итальянский Португальский Русский Испанский