Программирование

FoxPro for DOS или FPD 2.6
Сегодня сделаем ему поддержку длинных имен файлов в Windows 10.

Это будет интересно тем, кто до сих пор ведет и поддерживает работу базы данных на FPD, как например у нас.

Итак, имеем базу на FPD26, встал вопрос хранения и обмена различными файлами (*.docx, *.PDF. *.JPG и т.д.) с привязкой к записям в базе данных.

Соответственно, сами файлы мы в базу не запихаем, просто нет такой возможности, по этому храним в отдельном месте на сетевом диске. Необходимо обеспечить механизм загрузки файлов, привязки к конкретной записи и обеспечения всем доступа.

Проблему с длинными именами решаем следующим образом:

Пишем внешнее консольное приложение для получения списка файлов в директории с длинными именами. Я писал на Лазарус. Список сохраняем в файл. Исходники ниже. Главная строчка вот:

if ParamCount=2 then ShellExecute(0,nil, PChar('cmd.exe'),PChar('/c dir "'+ParamStr(1)+'" /X /O:GN /4 >"'+ParamStr(2)+'"'),nil,0);
В фоксе натравляем эту прогу на каталог, подхватываем файл и считываем из него содержимое каталога. Получаем во временном каталоге текстовый файл типа
Том в устройстве C имеет метку Windows
Серийный номер тома: D66A-389A
Содержимое папки C:\Program Files
20.08.2016 11:40 <DIR> .
20.08.2016 11:40 <DIR> ..
21.07.2016 11:50 <DIR> ~TAME6~1.0 ~Tame 6.0
23.04.2015 09:54 <DIR> 1cv82
25.02.2016 10:34 <DIR> 1PASSW~2 1Password 4
22.01.2013 07:09 <DIR> 2gis
27.06.2016 09:28 <DIR> 7-Zip
23.10.2012 12:44 <DIR> ACTIVE~1 ActiveRefresh
20.04.2016 14:33 <DIR> Adobe
15.07.2016 14:10 <DIR> APPLES~1 Apple Software Update
19.02.2016 12:40 <DIR> ASCON
15.07.2016 13:50 <DIR> AZFiles
25.02.2016 10:03 <DIR> CCleaner
27.06.2016 09:28 <DIR> CDBURN~1 CDBurnerXP
05.08.2016 10:22 <DIR> CMAK
24.08.2016 09:42 <DIR> COMMON~1 Common Files
02.09.2014 12:33 <DIR> CONNEC~1 Connect Manager
04.08.2016 13:13 <DIR> DIFX
25.02.2016 11:19 <DIR> DOWNLO~1 Download Master
13.07.2016 14:33 <DIR> Dropbox
07.09.2016 06:06 <DIR> DrWeb
19.08.2015 15:27 <DIR> DRWEBE~1 DrWeb Enterprise Suite
24.02.2016 16:17 <DIR> DVDMAK~1 DVD Maker
02.08.2016 16:23 <DIR> DVRCMS
20.08.2016 11:40 <DIR> Evernote
15.08.2016 13:07 <DIR> FARMAN~1 Far Manager
11.03.2016 08:33 <DIR> FOXITS~1 Foxit Software

Вот функция анализа этого текстового файла:

*Список файлов и папок для указанной директории ложит в курсор (базу данных)
* _dir -имя каталога в форме 8.3 и не только кстати
* _curname - имя создаваемого курсора, если есть, то пересоздается
FUNCTION DBFNget
param _dir, _curname
private st, tmptxt, time_curr, time_pred
private ifp, s
tmptxt=TMP_NET+'mydir.txt'
delete file &tmptxt
if tkfile(tmptxt)
wait window 'Не могу удалить временный файл ' + tmptxt
return .F.
endif
st='!mydir "'+_dir+'" "'+tmptxt+'"'
&st
time_pred=seconds()
* ждем 3 секунды чтобы прога создала файл
* а также закончила сего создавать, то есть чтобы дала нам его открыть для записи - ТАКОЕ БЫЛО - ЧТО СОЗДАН НО ЕЩЕ ЗАПИСЫВАЕТ В НЕГО
ifp=-1
do while ifp<0 and (seconds()-time_pred)<=3
ifp = FOPEN(tmptxt,2)
enddo
IF ifp < 0
wait window 'Не могу открыть файл ' + tmptxt
return .F.
ENDIF
CREATE CURSOR &_curname (fdate D, ftime C(5), fdir L, fsize N(17,0), fname C(8+3+1), fname_long C(254))
DO WHILE (!FEOF(ifp))
s=FGETS(ifp)
m.fdate=ctod(left(s,10)) && строка начинается с даты
if not empty(m.fdate)
m.ftime=substr(s,13,5) && 13-ая позиция - время
st=chrtran(substr(s,19,17)," "+chr(255),"") && 19-ая позиция - размер или признак директории
m.fdir='<DIR>'$st
*?st, asc(substr(st,3))
m.fsize=val(st)
m.fname=chrtran(substr(s,37,8+3+1),chr(255),"") && 37-ая позиция - короткое имя
*?m.fname
m.fname_long=chrtran(substr(s,50),chr(255),"") && 50-ая позиция - длинное имя
*?m.fname_long
m.fname=IIF(empty(m.fname),upper(m.fname_long),m.fname)
if not m.fname=="."
*?fdate,ftime, m.fdir,m.fsize,m.fname,m.fname_long
insert into &_curname from memvar
endif
endif
ENDDO
=FCLOSE(ifp)

RETURN .T.
Выводим POPUP, получаем типа Фара, но в фоксе - FoxPro Commander !!!

*Процедура ходит по папкам и выбирает файл
*Процедура рекурсивная
* _long=.t. - возвратить имя файла в длинном формате или в 8.3
*_onlyview=.t. - чисто просмотр (без хождения по папкам)
*_position - номер позиции на какую надо встать в писке
*_goto - надо ли вставать на эту позицию или нет, тогда просто передается номер позиции
*эти два параметра первоначально можно не указывать, они только в рекурсии работают
FUNCTION DBFNfile
param _title,_curr_path, _long, _onlyview,;
_position, _goto, _x, _y

private _r

if not DBFNget(_curr_path,'mycur')
RETURN ""
endif

_x=IIF(empty(_x),3,_x)
_y=IIF(empty(_y),2,_y)
*по горизонтали по центру экрана, а по вертикали от _y до низа экрана
DEFINE POPUP POP_M;
FROM _y,_x TO wrows()-2, wcols()-_x-2;
IN SCREEN ;
PROMPT FIELD left(mycur.fname_long,60)+IIF(mycur.fdir,[DIR ],[FILE]);
SCROLL SHADOW TITLE IIF(empty(_title),_curr_path,_title)

on select POPUP POP_M DEACTIVATE POPUP POP_M
if not empty(_goto) and not empty(_position)
go record _position in mycur
else
go top
endif

ACTIVATE POPUP POP_M REST
release POPUP POP_M

IF NOT lastkey() = 27
if mycur.fdir
if _onlyview=.F.
if mycur.fname_long='..'
RETURN DBFNfile(_title,getnamepath(_curr_path,1), _long, _onlyview, _position,.T.,_x,_y)
else
RETURN DBFNfile(_title,_curr_path+allt(IIF(_long,mycur.fname_long,mycur.fname))+'\', _long, _onlyview, recno('mycur'),.F.,_x,_y)
endif
else
RETURN ""
endif
else
release POPUP POP_M
_r=allt(_curr_path+IIF(_long,mycur.fname_long,mycur.fname))
=closedb('mycur')
RETURN _r
endif
ENDIF

=closedb('mycur')

RETURN ""

*who=1 - Из пути c:\1\2\ дает предыдущий путь c:\1\
*who=2 - Из пути c:\1\2\ дает имя папки "2" - не пригодилось - передается номер позиции, а не название каталога как предполагалось сначала
FUNCTION getnamepath
param _path, _who
private i
i=1
do while at('\',_path,i)>0
i=i+1
enddo
if i<=2
RETURN _path
endif
RETURN IIF(_who=1,substr(_path,1,at('\',_path,i-2)),;
chrtran(substr(_path, at('\',_path,i-2)),[\],[]) )