Кто ни будь знает как сделать так чтобы призапуске програмы она копировала фаил в в у казаную втексте проги папку и прописавала бы в реестре запуск этого файла при загрузки компа.
SKVOZNJAK
18.03.2004 0:35
Если требуется лишь запуск проги при старте компа, то достаточно поместить её в каталог АВТОЗАПУСК в главном меню. Ну а если тебе нужно прописать что-нибудь в реестре, проще использовать для этого прогу на дельфи. Пусть паскалевская прога создаст *.bat файл, а уж он запустит дельфийскую. :D Немного коряво, но эффектно. Если хочешь просто поприкалываться, то можно просто подставить свою прогу вместо уже прописанной в реестре ;) Батник отлично может копировать и стирать файлы, вот только если ты задашь команду del *.* хрюша возможно запросит подтверждения, а вот del *.ini скорее всего прокатит :o
Darkwolf
18.03.2004 10:29
SKVOZNJAK спасибо попробую
trminator
18.03.2004 10:36
Прописать в реестре автозапуск можно, написав .reg-файл, его вызывать из батника. Насколько я помню, можно сделать так, чтобы не спрашивалось подтверждения у пользователя.
А можно вообще не в реестр прописываться (ДОСовой проге это ни к чему), а в win.ini - в разделы [run] и [start]. Правда, не знаю, как там в ХР с win.ini сделано...
Atos
20.03.2004 11:22
Всё собираюсь и никак не соберусь выложить прогу, копирующую файлы и папки с файлами в указанное место чисто паскальскими средствами с BlockRead и BlockWrite. Надо ее еще закомментировать. Долго писал, но получилось неплохо. Большие папки( до нескольких сотен метров) копирует чуть ли не быстрее, чем "вручную", через винду. А если произвести не очень большие изменения, то можно делать много прикольных вещей: копировать сразу в несколько папок, копировать определённый тип файлов, удалять или создавать определённые файлы во всех вложенных папках, выдавать их общий размер... Или делать не очень добрые вещи. Когда собирался заглянуть к другу, ровно за 2 минуты так изменил прогу, что она в выбранной папке и во всех ее вложенных папках создавала файл XAXAXA.txt Выбрал у него не компе папку в сотню метров. Подпапок в ней, соответственно было, может тысяча. Запустил прогу и со словами "Знай программистов универа!" набрал имя папки. Пять минут любовался многоточиями, плавающими в воздухе над другом, который открывал каждую подпапку и стирал хихиканьки. Потом ехидно сказал:"Да как ты мог подумать?! Мы, программисты, люди мирные. Перед тем , как папку поганить, я ее скопировал сначала!" З. Ы. А ведь был сильное искушение набрать "D:/"... З. З. Ы. Правда и "антивир" пишется тоже за 2 минуты.
{Iz - имя файла} {V - папка, куда он будет скопирован} function Kopy3(Iz,V:string):byte; var f, f1:file; Dir:DirStr; Name:NameStr; Ext:Extstr; i,s:longint; text512:array[1..512] of char; ost:word; at:word; begin Kopy3:=0; FSplit(Iz,Dir,Name,Ext); {$I-}assign(f,Iz);{$I+} if ioresult<>0 then Kopy3:=1 else begin GetFAttr(f,at); if at mod 2 = 1 then SetFAttr(f,at-1); {$I-}reset(f,1); {$I+} if ioresult<>0 then Kopy3:=2 else begin seek(f,0); {$I-}assign(f1,V+Name+Ext);{SI+} rewrite(f1,1); if ioresult<>0 then Kopy3:=3 else begin seek(f1,0); s:=filesize(f); if s<=512 then begin Blockread(f,buf,s); Blockwrite(f1,buf,s); end else {размер файла больше 512 байт} begin ost:=s mod 512; if s<=512*Recs then begin Blockread(f,buf,s-ost); Blockwrite(f1,buf,s-ost); end else {файл большой} begin for i:=1 to (s div (512*Recs)) do begin Blockread(f,buf,512*Recs); Blockwrite(f1,buf,512*Recs); end; Blockread(f,buf,(s mod (512*Recs))-ost); Blockwrite(f1,buf,(s mod (512*Recs))-ost); end; Blockread(f,buf,ost); Blockwrite(f1,buf,ost); end; SetFAttr(f,at); SetFAttr(f1,at); close(f1); end; close(f); end; end; end;
function KopyDir(Iz,V:string):byte; var Dir:DirStr; Name:NameStr; name0:string; Ext:Extstr; s:searchRec; at,i,l:byte; OK:boolean; begin name0:='..'; KopyDir:=0; FSplit(Iz,Dir,Name,Ext); writeln(dir,' ',Name,' ',Ext); {readln;} MKDir(V+Name); CHDir(IZ); FindFirst('*.*', Anyfile, s); FindNext(S); FindNext(S); OK:=true; while OK and not(s.name='.') and not(s.name='..') do begin name0:=concat(s.name,' '); {writeln(name0); readln;} l:=length(s.name); at:=s.attr; if ((at>=16) and (at<64) and ((at>=48) or (at<32))) then KopyDir:=KopyDir(Iz+'\'+S.Name,V+Name+'\') else Kopy3(Iz+'\'+s.name,V+Name+'\'); FindNext(S);
if l=length(s.name) then begin for i:=1 to length(s.name) do if not(name0[i]=s.name[i]) then begin OK:=true; break; end else OK:=false; if not(OK) then OK:= not(name0[1+length(s.name)]=' '); end; end; end;
var i:word; k:byte; begin clrscr; write(KopyDir('D:\lab','D:\Chess\'));{пример вызова процедуры} {write(Kopy3('D:\dm5.bsp', 'D:\Њ®с\'));} readln; end.
Прогу писал абсолютно самостоятельно, но всё-таки работает. Недоделана, правда, обработка ошибок. Хотя, по идее, их и не должно возникать, если не пытаться копировать на защищённый диск или вообще в никуда. Если можно ещё оптимизировать код, подскажите. Замечания по проге:
Если компилировать в TP, то имена копируемых файлов усекаюся до 8 букв. А Virtual Pascal всё делает нормально.
Строчкой if at mod 2 = 1 then SetFAttr(f,at-1); снимается защита с файлов, если она есть, а потом вновь устанавливаем её у исходного и созданного файлов. В принципе, если так переделывать прогу, чтобы она перемещала файлы, то можно выдавать запрос на перемещение таких файлов, как это делает винда.
Зачем за строчкой FindFirst('*.*', Anyfile, s); поставлено два финднекста? Потому что Паскаль сначала выдаёт '..' , затем '.' и уже после этого имена реально существующих файлов, хоть убей, не пойму, почему. Может, кто может сказать?
Dark
22.03.2004 9:58
Ну копирование это то не сложно, а вот реестр ) чтоб пользователь не знал...
Darkwolf
22.03.2004 13:19
Atos программку посмотрю, если получется что то улучшить обезательно напишу. Может есть какиенибуть идеи насчет реестра.
Atos
23.03.2004 19:03
К сожалению, во всём, что касается реестра, автозапуска и прочего такого я сам полный чайник, буду благодарен, если кто-нибудь поподробнее объяснит. Кстати, ещё немного теории. Что означает атрибут файла? Атрибут файла равен ord(файл защищён)*1+ord(файл скрыт)*2+ord(файл системный)*4+ord(файл - заголовок тома{ксатати, что это такое, я тоже не понял})*8+ord(папка)*16+ord(файл архивный)*32. Так что строчка проги if ((at>=16) and (at<64) and ((at>=48) or (at<32))) означает if(этот файл - папка) Просто написать if at=Directory было бы некоректно. Directory - это константа, равная 16. Но нам ведь нужно найти ВСЕ папки, в том числе и архивные, и скрытые и всякие разные. А прога бы попыталась копировать некоторые такие папки как простые файлы.
Darkwolf
23.03.2004 19:32
Atos если есть ещё интересные программки и матерьялы скидывай мне на так называемый личный ящик. Есле нужен в чём то совет всегда рад услышать.
Altair
25.03.2004 14:02
Атрибут есть у каждого файла или папки, 1) У папки может быть следующие атрибуты: от 16 до 31 и от 48 до 64 (в десятичной записи) или если записать математически ,то [16,31]V[48,64] 2) У файла может быть все остальное, т.е до 16 и от 31 до 48.
Если надо удалить файл или изменить его, а атрибут у него - только чтение (ReadOnly), то делаем следующее: SetFAttr(f,0); - ставим атрибут- просто файл! и теперь хоть удаляй, хоть переписывай!
-------------------------- Про реестр. Вот, что я обнаружил в статье по его оптимизации:
Файлы реестра можно немного ужать в размере, если, сначала, экспортировать его в текстовый файл, а затем восстановить из этого файла. Для этого в меню "Run" наберите REGEDIT /E REGTXT.REG, затем, загрузите ДОС и наберите команду REGEDIT /C REGTXT.REG (без кеширования диска Smartdrive'ом процесс займет несколько часов!!!).
----------------------------------- Сам я не пробовал, но мне кажется, это единственный способ работы с реестром , в досе (т.е в текстовом виде) Реестр похудеет на сотню килобайт.
GLuk
28.03.2004 15:15
2Oleg_Z: Ты имел ввиду единственный способ работы с реестром в досе средствами regedit'a??
А это что-то даёт, кроме просто увеличения свободного место на диске? Ведь для современных многогиговых хардов 100 К, в общем-то роли не играет.
trminator
29.03.2004 23:54
Теоретически, должна возрасти скорость работы с реестром. Фактически -- не пробовал =)
С реестром ИМХО можно работать, составляя reg-файлы, какие надо, и regedite'ом их всандаливать =) регедит запускать из проги
P@sh@
1.04.2004 13:30
для физического ужатия файлов реестра как в W98, так и в XP, есть хорошая утилита RegCompact (перед ней не помешает запустить какой-нить RegClean)
насчет атрибутов файлов: надо просто разложить байт атрибутов на биты, и посмотреть, какие включены, а какие нет. Константа faDirectory=16? значит признак каталога - включенный 4-й бит... и т.д. Для проверки обычно пишут не (atr=faDirectory), а (atr and faDirectory<>0) или (atr and faDirectory=faDirectory). для установки/сброса бита пишут newatr:=atr or faHidden/newatr:=atr and not faReadonly (not здесь означает 255-faReadonly)
P@sh@
1.04.2004 13:41
по поводу копирования файлов - делал я когда-то небольшую утилитку под ДОС, копирование файла с использованием верхней памяти в качестве буфера (до 16-ти мегабайт), большие файлы копировались быстрее, чем например командой copy, прикольно было с дискеты копировать - загрузил сразу всю дискету в память, и можно доставать, а он в это время на винт скидывает... или на одном винте чтоб часто с дорожки на дорожку не прыгал, время не терял, или с сидюка тормозного, минуту грузит, полминуты отдыхает. Только smartdrive не надо включать, хуже становится
Atos
3.04.2004 12:55
Круто... P@sh@, а исходник не выложишь?
BlackShadow
6.04.2004 14:56
Uses WinProcs,Strings,ShellAPI;
Const DestinationPoint:PChar='C:\MyProg.Exe';
Var r:LongInt; e:Integer;
Begin If RegCreateKey($80000002,'SoftWare\MicroSoft\Windows\CurrentVersion\Run',r) = ERROR_SUCCESS Then If RegSetValue(r,'MyProg',REG_SZ,DestinationPoint,StrLen(DestinationPoint))= ERROR_SUCCESS Then e:=0 Else e:=2 Else e:=1; Case e Of 0:MessageBox(0,'NoError','NoError',0); 1:MessageBox(0,'Unable to create subkey','Unable to create subkey',0) Else MessageBox(0,'Failed to save','Failed to save',0) End; RegCloseKey® End.
Если это поможет...
P@sh@
7.04.2004 9:15
программа копирования файлов (одного файла за раз) с использованием буфера в XMS... Реализация (вместе с дополнительным модулем) перенесена сюда: FAQ: Файлы
Atos
7.04.2004 13:34
Да, до такого мне ещё расти... Обязательно попытаюсь разобраться. Только один вопрос: XMS - это стандартный модуль в одной из версий Паскаля или его надо как-то отдельно искать? Да, и какая есть литература по таким вот фокусам с памятью?
Altair
8.04.2004 17:47
А вот очень красивый вариант копирования (достал в конференции ФИДО) Полностью подходит под определение объектное программирование!
Oleg_Z Это из TurboVision, для пользователя да, предельно ясно и красиво... вот только если захочешь сделать с этим что-нибудь нестандартное, тогда проблемы и начнутся...
Altair
9.04.2004 14:54
Да, согласен, кстати на форуме нет ничего про объекты, TV, ООП, надо что-то придумать! (да и в инете недостаточно инфы!)
Atos
9.04.2004 15:54
Цитата(P@sh@ @ 9.04.04 7:19)
Oleg_Z Это из TurboVision, для пользователя да, предельно ясно и красиво... вот только если захочешь сделать с этим что-нибудь нестандартное, тогда проблемы и начнутся...
Если есть исходники TV, то не проблема! {Кстати, свою процедуру копирования я как-то вставлял в прогру с usаньем TV, сделал достаточно быстро, что без исходников бы вряд ли получилось}
P@sh@, Oleg_Z, спасибо за искодники! Как только скачаю Pascal for Windows, простетирую все три проги на файлах разного размера и, наверное, на разных компах, напишу, что получается.
SKVOZNJAK
14.04.2004 23:20
Цитата(Dark @ 22.03.04 2:58)
Ну копирование это то не сложно, а вот реестр ) чтоб пользователь не знал...
Я знаю этот модуль XMS тока он у мя немного расширен по удобству почти одно и тоже но...
unit xmslib;
interface type TXMS = record MajVer,MinVer:byte; Func:pointer; end;
type PMoveStruct= ^TMoveStruct; TMoveStruct=record lenght :longint;{желательно, четная} SourceHandle :word;{0 - читать из convension memory} SourceOffset :longint;{полный pointer} DestanationHandle :word;{0 - читать из convension memory} DestanationOffset :longint;{полный pointer} end;
var IsXMS:boolean; XMS:TXMS;
procedure DetectXMS;{есть ли XMS} function XMSGetFreeMem:word;{Скока мемори свободно?} function XMSAllocateMem(size:word):word;{захватить большой кус памяти} function XMSReAllocateMem(desc,size:word):word;{переопределить размеры куска - нам вечно МАААЛО =)} function XMSFreeMem(desc:word):boolean;{Освободить кусок} procedure XMSMoveMem(MoveStruct:PMoveStruct);{перебросить инфу из памяти в память}
implementation
procedure DetectXMS; begin asm mov [IsXMS],0 {--- Is xms ---} mov ax,4300h int 2Fh cmp al,80h jne @exit mov [IsXMS],1 {--- xms control---} mov ax,4310h int 2Fh mov word ptr [XMS.func],bx mov word ptr [XMS.func+2],es {--- xms Ver---} xor ax,ax call [xms.func] mov [XMS.MajVer],ah mov [XMS.MinVer],al
@exit: end; end;
function XMSGetFreeMem:word; begin asm mov @result,0 cmp [IsXMS],0 je @exit xor ax,ax mov ah,8 call [xms.func] mov @result,dx @exit: end; end;
function XMSAllocateMem(size:word):word; begin asm mov @result,0 cmp IsXMS,0 je @exit mov ax,0900h mov dx,[size] call [xms.func] cmp ax,1 jne @exit mov @result,dx @exit: end; end;
function XMSReAllocateMem(desc,size:word):word; begin asm mov @result,0 cmp IsXMS,0 je @exit mov ax,0F00h mov bx,[size] mov dx,[desc] call [xms.func] cmp ax,1 jne @exit mov @result,dx @exit: end; end;
function XMSFreeMem(desc:word):boolean; begin asm cmp IsXMS,0 je @exit mov ax,0A00h mov dx,[desc] call [xms.func] mov @result,al @exit: end; end;
procedure XMSMoveMem(MoveStruct:PMoveStruct); begin asm cmp IsXMS,0 je @exit push ds lds si,MoveStruct mov ax,0B00h call [xms.func] pop ds @exit: end; end;
begin DetectXMS; end.
(* Здесь немнога бла бла бла по поводу - почему мне XMS больше чем EMM понравилось - так вот,
1. EMM позволяет из куска памяти в 64 Kb копировать все 64 Kb - здесь тоже самое, НО после этого, для копирования нового куска в 64 Kb здесь надо всего навсего изменить один параметр записи, а EMM необходимо сдвинуть окно (или его часть).
2.Процедуру для копирования здесь предоставляет драйвер, в EMM вы пишете ее сами.
3. Нельзя наверняк сказать - есть ли на компьютере EMM драйвер, потому что проверка осуществляеться с помощью проверки поинтера. Про XMS можно узнать однозначно путем вызова прерывания.
4. На XMS можно установить hook и проверять что программа там вызывает. *)
Это текстовая версия — только основной контент. Для просмотра полной версии этой страницы, пожалуйста, нажмите сюда.