Форум » [x]Harbour » Экспорт в текстовый файл из базы » Ответить

Экспорт в текстовый файл из базы

Eduard: Добрый день уважаемые форумчане. Необходима ваша помощь в написании подпрограммы для экспорта данных из базы в текстовый файл. Есть такие данные: база с записями о приеме в почтовых отделениях платежей на пользу украинского банка (погашение кредита). Необходимо сформировать реестр в тестовом виде в формате win1251. Сама база и описание структуры реестра находиться в архиве, ссылка ниже. ссылка на архив Заранее спасибо, Эдуард.

Ответов - 4

Vlad04: А в чем проблема? SET PRINTER to 'AL_XXXXX.txt ' Не проканывает или проблема с кодировкой?

SADSTAR4: поместить экзешник в папку для обработки туда же - альфа.дбф запустить экзешник получить текстовые файлы в той же папке код [pre] function Main() local cFile SET DATE TO GERMAN set century on CLS cFile:=EXENAME() IF (nPos := RAT("\", cFile)) != 0 ApplicPath = SUBSTR(cFile, 1, nPos) ELSE ApplicPath = "" ENDIF // DbFile:=ApplicPath+"alfabank.dbf" ? DbFile if !file(DbFile) ? "File <"+DbFile+"> not found" Inkey(0) return Nil endif use &DbFile READONLY IF NETERR() ? "Open Error -> exit" Inkey(0) return NIL endif aPostIdx:={} PostIdx:="" dbGotop() do while !eof() n:=ASCAN( aPostIdx, KOD_OS) if n=0 aAdd(aPostIdx,KOD_OS) ? KOD_OS endif dbSkip() enddo for i:=1 to len(aPostIdx) PostIdx:=aPostIdx cFile:="AL_"+PostIdx+".txt" ?cFile SET FILTER TO KOD_OS = PostIdx SET PRINTER TO &(cFile) SET PRINTER ON SET CONSOLE OFF dbGoTop() do while !eof() ? DtoC(DATA) ?? PIB ?? padR(alltrim(str(RAXUNOK,20)),20) ?? padR(alltrim(str(SUMMA, 25, 2)),20) ?? NOMER_DOG ?? DtoC(DATA_DOG) ?? KOD_OS dbSkip() enddo SET PRINTER OFF SET CONSOLE ON next ? "--------------------" ?'Success - press any key' Inkey(0) return Nil [/pre]

gustow: SADSTAR4 пишет: for i:=1 to len(aPostIdx) PostIdx:=aPostIdx Как обычно (или часто ;) ) позабыты пробелы вокруг "i" в квадратных скобках - в данном случае должно быть PostIdx:=aPostIdx [ i ] Тщательней надо, товарищи... ;)


Eduard: Всем спасибо за помощь. Есть еще один вопрос, есть программа для обработки базы (используются функции TBrowse ...), своего рода такой вот редактор баз данных, взят из книги Н.Сухова Практический курс программирования на CA-Clipper) Необходимо в редактор БД добавить функцию, которая будет вызывать доп. функцию в определенном поле, и записывать значение этой функции в редактируемое поле (своего рода справочник) вот сам листинг функции из этой книги Надеюсь я правильно объяснил? Мне необходимо что-б в основной программе в поле "Код-ОС" вызывался по определенной клавише функция справочника (доп. это будет Ф12), в справочнике будет выбираться определенный элемент, и значение этого элемента должно-быть помещено в это поле как результат где-то так... ******************************************************* * s_BROWS.PRG * * Просмотр и редактирование файла БД * ******************************************************* #Include "Inkey.ch" #Include "Box.ch" #Include "SetCurs.ch" #Include "Error.ch" #Include "MaxScr.ch" #Include "Mydefs.ch" EXTERNAL s_VIEW_F EXTERNAL s_stat EXTERNAL s_funfun ******************************************************* * Просмотр и редактирование файла БД * * в текущей рабочей области * *-----------------------------------------------------* * pFunc - функция обработки клавиш F1...F10 * * p_help - Нортон-меню, функциональных клавиш * * p_field - массив отображаемых полей * * p_name - массив заголовков полей * * p_titl - общий заголовок окна редактирования * ******************************************************* Function s_BROWSE(pFunc, p_help, p_field, p_name, p_titl, Help_F, pStLine,PsFunFun) Local browse, t_cur, nKey, scr Local t_column, t_column1, n, nk, cType, tcol Local t_col, b_col Local v_help[10], t_word Local row, col, row_e, col_e Local zag:="Редактор баз данных" scr=SAVESCREEN(0,0,24,79) Private uFunc, usblok, uStLine, uslBlock Private buffer IF Help_F=NIL t_word=M->h_word M->h_word="BROWSE" ELSE t_word=M->h_word M->h_word=Help_F ENDIF uFunc:=IF(pFunc==NIL,"s_view_f",pFunc) uStLine:=IF(pStLine==NIL,"s_stat",pStLine) PsFunFun:=IF(PsFunFun==NIL,"s_funfun",PsFunFun) usblok:="{|p1,p2,p3,p4|"+uFunc+"(p1,p2,p3,p4)}" *uslBlock:="{|p1|"+uStline+"(p1)}" p_titl=IF(p_titl==NIL,zag,p_titl) row=MY_ROW col=MY_COL row_e=MY_ROW_E col_e=MY_COL_E t_col=SETCOLOR("N/W") s_WSAVE(0,0,N_MAXROW,N_MAXCOL) SETCOLOR(M->wc_help_fr) @ 0,0 CLEAR TO 2, N_MAXCOL @ 0,0,2,N_MAXCOL BOX B_DOUBLE IF PCOUNT() #0 .AND. VALTYPE(p_titl)="C" b_col=(N_MAXCOL-1-LEN(p_titl))/2 IF SUBSTR(p_titl,1,1)="^" SETCOLOR(M->wc_help_h) @ 1,b_col SAY SUBSTR(p_titl,2) ELSE SETCOLOR(M->wc_help_n) @ 1,b_col SAY p_titl ENDIF ENDIF SETCOLOR(M->wc_br_fr) @ row, col CLEAR TO row_e, col_e @ row, col, row_e, col_e BOX B_DOUBLE_SINGLE @ row+2, col SAY MY_LEFTSEP @ row+2, col_e SAY MY_RIGTHSEP @ row_e-2, col SAY MY_LEFTSEP @ row_e-2, col_e SAY MY_RIGTHSEP s_FunFun(p_help) browse:=TBrowseDB(row+1,col+1,row_e-1,col_e-1) nk:=IF(p_field==NIL,FCOUNT(),LEN(p_field)) FOR n:=1 TO nk IF p_field==NIL t_column:=TBColumnNew(IF(p_name==NIL,Field(n),p_name[n]),; IF(TYPE(Field(n))=="M",{||"<MEMO>"},; FieldWBlock(Field(n),Select()))) ELSE t_column:=TBColumnNew(IF(p_name==NIL,p_field[n],p_name[n]),; IF(TYPE(Field(n))=="M",{||"<MEMO>"},; FieldWBlock(p_field[n],Select()))) ENDIF t_column:footing:=Field(n) browse:addColumn(t_column) NEXT browse:cargo:=.F. browse:skipBlock:={|x|SkipF(x,browse)} browse:headSep:=MY_HEADSEP browse:colSep:=MY_COLSEP browse:footSep:=MY_FOOTSEP DrColor(browse) t_cur:=SetCursor(SC_NONE) s_stat(browse) *sb_attach(4,77,22,nk,1) DO WHILE .T. nKey:=0 DO WHILE nKey = 0 .AND. .NOT. browse:stable browse:stabilize() nKey:=InKey() ENDDO IF browse:stable IF browse:hitBottom .AND. .NOT. browse:cargo browse:cargo:=.T. nKey:=K_DOWN ELSE IF browse:hitTop .OR. browse:hitBottom TONE(125,0) ENDIF browse:refreshCurrent() DO WHILE .NOT. browse:stabilize() ENDDO s_stat(browse) nKey:=Inkey(0) ENDIF ENDIF IF nKey == K_ESC .or. nKey == K_F10 EXIT ENDIF DO CASE CASE nKey==K_DOWN browse:down() CASE nKey==K_PGDN browse:pageDown() CASE nKey==K_CTRL_PGDN browse:goBottom() browse:cargo:=.F. CASE nKey==K_UP browse:up() IF browse:cargo browse:cargo:=.F. browse:refreshAll() ENDIF CASE nKey==K_PGUP browse:pageUp() IF browse:cargo browse:cargo:=.F. browse:refreshAll() ENDIF CASE nKey==K_CTRL_PGUP browse:goTop() browse:cargo:=.F. CASE nKey==K_RIGHT browse:right() CASE nKey==K_LEFT browse:left() CASE nKey==K_HOME browse:home() CASE nKey==K_END browse:end() CASE nKey==K_CTRL_LEFT browse:panLeft() CASE nKey==K_CTRL_RIGHT browse:panRight() CASE nKey==K_CTRL_HOME browse:panHome() CASE nKey==K_CTRL_END browse:panEnd() CASE nKey==K_DEL .AND. .NOT. EOF() .AND. LASTREC() # 0 IF DELETED() RECALL ELSE DELETE ENDIF DrColor(browse) KEYBOARD(CHR(K_DOWN)) browse:refreshAll() DO WHILE .NOT. browse:stabilize() ENDDO CASE nKey==K_INS SetKey(K_INS,{||InsToggle()}) s_stat(browse) CASE nKey==K_F1 IF !M->h_file=="" s_HELP() ENDIF CASE nKey=K_ALT_F2 browse:freeze = browse:colPos browse:refreshAll() CASE nKey=K_ALT_F3 browse:freeze = 0 browse:refreshAll() CASE nKey <= K_F2 .and. nKey >= K_F9 tcol:=browse:colPos browse:stable=.F. EVAL(&usblok,browse,tcol,nKey,p_name) browse:refreshAll() DO WHILE .NOT. browse:stabilize() ENDDO CASE nKey >= 32 .and. nKey < 256 KEYBOARD CHR(nKey) DoGet(browse) CASE nKey = K_ENTER DoGet(browse) ENDCASE ENDDO SETCURSOR(t_cur) SETCOLOR(t_col) RESTSCREEN(0,0,24,79,scr) s_WCLOSE() IF Help_F=NIL M->h_word=t_word ELSE M->h_word=Help_F ENDIF RETURN NIL ************ STATIC Function SkipF(n,browse) Local lAppend Local i, ind lAppend:=browse:cargo i:=0 IF n == 0 .OR. LASTREC() == 0 DBSKIP(0) ELSEIF n > 0 .AND. RECNO() != LASTREC() + 1 DO WHILE i < n DBSKIP(1) IF EOF() IF lAppend i++ ELSE DBSKIP(-1) ENDIF EXIT ENDIF i++ ENDDO ELSEIF n < 0 DO WHILE i > n DBSKIP(-1) IF BOF() EXIT ENDIF i-- ENDDO ENDIF RETURN i ************* STATIC PROCEDURE DoGet(browse) Local bIns, lScore, lExit Local colm, get, nKey Local lAppend, xOldKey, xNewKey *MEMVAR t_field PRIVATE t_field DO WHILE .NOT. browse:stabilize() ENDDO lAppend:=browse:cargo IF lAppend .AND. RECNO() == LASTREC() + 1 DBAPPEND() ENDIF xOldKey:=IF(EMPTY(INDEXKEY()),NIL,&(INDEXKEY())) lScore:=Set(_SET_SCOREBOARD,.F.) lExit:=Set(_SET_EXIT,.T.) bIns:=SetKey(K_INS) SetKey(K_INS,{||InsToggle()}) SetCursor(IF(ReadInsert(),SC_INSERT,SC_NORMAL)) t_field=FIELD(browse:colPos) IF VALTYPE(&t_field)="M" FIELD->&t_field=s_MEMO(4,4,N_MAXROW-2,N_MAXCOL-4,t_field,t_field,.T.) ELSE colm:=browse:getColumn(browse:colPos) get:=GetNew(ROW(),COL(),colm:block,colm:heading,,browse:colorSpec) ReadModal({get}) ENDIF SetCursor(0) Set(_SET_SCOREBOARD,lScore) Set(_SET_EXIT,lExit) SetKey(K_INS,bIns) xNewKey:=IF(EMPTY(INDEXKEY()),NIL,&(INDEXKEY())) IF .NOT. (xNewKey == xOldKey) .OR. (lAppend .AND. xNewKey != NIL) browse:refreshAll() DO WHILE .NOT. browse:stabilize() ENDDO DO WHILE &(INDEXKEY()) > xNewKey .AND. .NOT. browse:hitTop() browse:up() DO WHILE .NOT. browse:stabilize() ENDDO ENDDO ENDIF browse:cargo:=.F. nKey:=LASTKEY() IF nKey==K_UP .OR. nKey==K_DOWN .OR.; nKey==K_PGUP .OR. nKey==K_PGDN KEYBOARD(CHR(nKey)) ENDIF RETURN *********** STATIC PROCEDURE DrColor(browse) Local n, column browse:colorSpec:="BG/B,BG+/R,GR+/B,B/BG,W/B,B/BG,N/W,B+/BG" FOR n:=1 TO browse:colCount column:=browse:getColumn(n) column:defColor:={3,4} column:colorBlock:={||IF(DELETED(),{7,8},{5,6})} NEXT RETURN *********** Function show_insert() Local t_col t_col=SETCOLOR() SETCOLOR(M->wc_br_s) @ N_MAXROW-1, 70 SAY IF(READINSERT(),"<Вставка>","<Замена> ") SETCOLOR(t_col) RETURN NIL *********** STATIC PROCEDURE InsToggle() IF READINSERT() READINSERT(.F.) SETCURSOR(SC_INSERT) ELSE READINSERT(.T.) SETCURSOR(SC_NORMAL) ENDIF show_insert() RETURN *********************** *Сохранение мемо-поля * *********************** Function Memo_txt(tcol) Local kv, w_nfo, t_ff, buffer buffer=FIELDGET(tcol) t_ff=SPACE(12) s_SYS(1,"Копирование Мемо-поля "+FIELD(tcol)+" в текстовый файл") kv=s_GET("Имя файла для сохранения ",@t_ff,"@S12") s_SYS() IF kv=1 IF t_ff=="" s_ERR("Ошибочное выражение") ENDIF w_nfo=FCREATE(t_ff,0) IF FERROR()#0 s_ERR("Нельзя создать файл "+t_ff,"Ошибка ОС "+TRIM(STR(FERROR()))) RETURN(0) ENDIF FWRITE(w_nfo, buffer, LEN(buffer)) FCLOSE(w_nfo) ENDIF RETURN NIL ************************* *Востановление Мемо-поля* ************************* Function Txt_Memo(tcol) Local kv, w_nf, w_dl, d_buf, buffer, t_ff t_ff=SPACE(12) s_SYS(1,"Востановление Мемо-поля ",+FIELD(tcol)+" из текстового файла") kv=s_GET("Имя исходного файла",@t_ff,"@S12") s_SYS() IF kv=1 IF t_ff=="" s_ERR("Ошибочное выражение") ELSE w_nf=FOPEN(t_ff,0) IF FERROR()#0 s_ERR("Нельзя открыть файл "+t_ff,"Ошибка ОС ",+TRIM(STR(FERROR()))) RETURN(0) ENDIF w_dl=FSEEK(w_nf,0,2) buffer=SPACE(w_dl+10) FSEEK(w_nf,0) d_buf=FREAD(w_nf,@buffer,w_dl) FIELDPUT(tcol,buffer) FCLOSE(w_nf) DBCOMMIT() ENDIF ENDIF RETURN NIL *************************** *Запоминание поля в буфере* *************************** Function Buf_SAVE(tcol) M->buffer=FIELDGET(tcol) s_SYS("Поле "+FIELD(tcol)+" копируется в буфер",; "Переместите курсор на нужное поле",; "Нажмите клавишу F8 для копирования",; "информации из буфера в указаное поле") INKEY(1) s_SYS() RETURN NIL ****************************** *Востановление поля из буфера* ****************************** Function Buf_Rest(tcol) IF RECNO() > LASTREC() DBAPPEND() s_stat() ENDIF FIELDPUT(tcol,M->buffer) DBCOMMIT() RETURN NIL ************************************ *Получение информации о базе данных* ************************************ Function Inform() Local t_fr, t_n, t_h, curs curs=SETCURSOR() SETCURSOR(0) t_fr=M->wc_g_fr t_n=M->wc_g_n t_h=M->wc_g_h M->wc_g_fr=M->wc_help_fr M->wc_g_n=M->wc_help_n M->wc_g_h=M->wc_help_h s_LIST(,,,.T.,,,; "Имя файла БД :",ALIAS(),"",; "Количество записей :",LASTREC(),"",; "Индекс управляющий :",INDEXKEY(0),"",; "Фильтр :",TRIM(DBFILTER()),"") INKEY(0) M->wc_g_fr=t_fr M->wc_g_n=t_n M->wc_g_h=t_h SETCURSOR(curs) s_WCLOSE() RETURN NIL *************** Function MENUSHELL(browse) Local nz, t_ret, t_ntx, t_fin, t_log, t_base, rt, kv Local menu, menu1, menu2, menu3, menu4, menu5, menuw Local scr, t_dbf Private frame:=CHR(194)+CHR(194)+CHR(179)+CHR(217)+; CHR(196)+CHR(192)+CHR(179)+" " // ┬ ┬ │ ┘ ─ └ │ Private mac, t_ind t_ret=0 menu:=menu1:=menu2:=menu3:=menu4:=menu5 t_log=.T. scr=SAVESCREEN(0,0,24,79) DO WHILE .T. menuw=s_MENUBAR(0,0,@menu,"Переход;Поиск;Порядок;Установка;Утилиты;",t_log) t_log=.F. DO CASE CASE menuw=0 s_wclose() RESTSCREEN(0,0,24,79,scr) EXIT CASE menu=1 t_log=.T. DO WHILE .T. menuw=s_MENU_new(2,0,@menu1,; "Начало;Конец;Запись;Относительно;",; .T.,.F.,.T.,t_log,B_SINGLE) t_log=.F. DO CASE CASE menuw=0 t_ret=1 EXIT CASE menuw=2 KEYBOARD CHR(K_LEFT)+CHR(K_ENTER) EXIT CASE menuw=3 KEYBOARD CHR(K_RIGHT)+CHR(K_ENTER) EXIT CASE menu1=1 browse:goTop() t_ret=1 EXIT CASE menu1=2 browse:goBottom() t_ret=1 EXIT CASE menu1=3 nz=RECNO() rt=S_GET("Перейти к записи № ",@nz,"99999") IF rt#0 DBGOTO(nz) ENDIF t_ret=1 EXIT CASE menu1=4 nz=1 rt=S_GET("Перейти на № записей ",@nz,"99999") IF rt#0 EVAL(browse:skipBlock,nz) ENDIF t_ret=1 EXIT ENDCASE ENDDO CASE menu=2 t_log=.T. DO WHILE .T. menuw=s_MENU_new(2,12,@menu2,; "По индексу;Последовательно;",; .T.,.F.,.T.,t_log,B_SINGLE) t_log=.F. DO CASE CASE menuw=0 t_ret=1 s_WCLOSE() EXIT CASE menuw=2 KEYBOARD CHR(K_LEFT)+CHR(K_ENTER) EXIT CASE menuw=3 KEYBOARD CHR(K_RIGHT)+CHR(K_ENTER) EXIT CASE menu2=1 IF INDEXKEY(1)=="" s_ERR("Прямой поиск не возможен ",; "т.к. файл не индексирован ") t_ret=1 EXIT ENDIF t_ind=INDEXKEY(1) IF TYPE(t_ind)="C" mac=REPL(' ',50) s_GET("Выражение для поиска ",@mac,"@S25") SEEK TRIM(mac) IF .not. FOUND() s_ERR("Запись не найдена ") ENDIF ENDIF IF TYPE(t_ind)="N" nz=0.00 s_GET("Выражение для поиска ",@nz,"") mac=TRIM(STR(nz)) SEEK mac IF .not. FOUND() s_ERR("Запись не найдена ") ENDIF ENDIF t_ret=1 EXIT CASE menu2=2 mac=SPACE(50) rt=s_GET("Выражение для поиска ",@mac,"@S25") IF TYPE(mac) # "L" s_ERR("Ошибочное выражение ") ELSE IF rt#0 LOCATE for &mac IF .not. FOUND() s_ERR("Запись не найдена ") ENDIF ENDIF ENDIF t_ret=1 EXIT ENDCASE ENDDO CASE menu=3 t_log=.T. DO WHILE .T. menuw=s_MENU_new(2,21,@menu3,; "Индексирование;Сортировка;",.T.,.F.,.T.,t_log,B_SINGLE) t_log=.F. DO CASE CASE menuw=0 t_ret=1 s_WCLOSE() EXIT CASE menuw=2 KEYBOARD CHR(K_LEFT)+CHR(K_ENTER) EXIT CASE menuw=3 KEYBOARD CHR(K_RIGHT)+CHR(K_ENTER) EXIT CASE menu3=1 t_fin=PAD(TRIM(ALIAS())+".NTX",12) s_GET("Имя индексного файла :",@t_fin,"@!S12") IF AT(".NTX",t_fin)=0 t_fin=TRIM(t_fin)+".NTX" ENDIF t_ind=SPACE(50) rt=s_GET("Выражение для индекса :",@t_ind,"@S25") IF rt=0 s_ERR("Ошибочное выражение ") s_WCLOSE() S_STAT() EXIT ENDIF S_SYS("Ждите, идет индексирование...") t_ind=TRIM(t_ind) DBCREATEINDEX(t_fin,t_ind,{||&t_ind}) S_SYS() t_ret=1 EXIT ENDCASE ENDDO CASE menu=4 t_log=.T. DO WHILE .T. menuw=s_MENU_new(2,33,@menu4,; "Фильтр;Индекс;",.T.,.F.,.T.,t_log,B_SINGLE) t_log=.F. DO CASE CASE menuw=0 t_ret=1 s_WCLOSE() EXIT CASE menuw=2 KEYBOARD CHR(K_LEFT)+CHR(K_ENTER) EXIT CASE menuw=3 KEYBOARD CHR(K_RIGHT)+CHR(K_ENTER) EXIT CASE menu4=1 mac=REPL(" ",50) rt=s_GET("Выражение для фильтра ",@mac,"@S25") IF .not. EMPTY(mac) .and. TYPE(mac) # "L" s_ERR("Ошибочное выражение ") ELSE IF rt#0 SET FILTER TO &mac EVAL(browse:skipBlock,1) EVAL(browse:skipBlock,-1) ENDIF ENDIF t_ret=1 EXIT CASE menu4=2 s_SYS(2,"Выберите файл индекса") t_ntx=s_DIRSEL("*.NTX") IF !t_ntx=="" DBSETINDEX(t_ntx) ENDIF s_SYS() t_ret=1 EXIT ENDCASE ENDDO CASE menu=5 t_log=.T. DO WHILE .T. menuw=s_MENU_new(2,45,@menu5,; "Сжатие;Отмена;Копирование;Реорганизация;",; .T.,.F.,.T.,t_log,B_SINGLE) t_log=.F. DO CASE CASE menuw=0 t_ret=1 s_WCLOSE() EXIT CASE menuw=2 KEYBOARD CHR(K_LEFT)+CHR(K_ENTER) EXIT CASE menuw=3 KEYBOARD CHR(K_RIGHT)+CHR(K_ENTER) EXIT CASE menu5=1 s_SYS("Идет сжатие базы данных") PACK DBCOMMIT() s_SYS() t_ret=1 EXIT CASE menu5=2 t_ret=1 DBRECALL() EXIT CASE menu5=3 s_COPYFF(5,35) t_ret=1 EXIT CASE menu5=4 t_base=TRIM(ALIAS())+".DBF" kv=s_GET("Имя файла базы данных ",@t_base,"") IF kv=1 s_RECON(t_base) t_ret=1 EXIT ENDIF ENDCASE ENDDO ENDCASE IF t_ret=1 s_WCLOSE() restscreen(0,0,24,79,scr) EXIT ENDIF ENDDO RETURN NIL ************** Function s_CopyFF(top,left) Local kp:=FCOUNT(), kv, t_fil, t_rec:=RECNO() Local ind, mf:={}, dl_mf, i, titls:="Выберите поля:" Local logo:=.T., menuw, menu1:=1 Local fname:={} ASIZE(fname,kp) AFIELDS(fname) ind=SPACE(kp) DO WHILE .T. menuw=S_MENU_NEW(top,left,@menu1,fname,ind,,.T.,Logo,B_DOUBLE,Titls) logo=.F. DO CASE CASE menuw=0 s_WCLOSE() EXIT CASE menuw=3 .or. menuw=2 t_fil=SPACE(12) kv=s_GET("Введите имя выходного файла",@t_fil,"") IF kv#0 FOR i=1 TO kp IF SUBSTR(ind,i,1)==CHR(251) AADD(mf,fname) ENDIF NEXT dl_mf=LEN(mf) IF dl_mf=0 kv=s_ERR("Будут скопированы все поля","%[ Да ]","[ Нет ]") IF kv#1 logo=.T. LOOP ENDIF ACOPY(fname,mf) dl_mf=kp ENDIF IF dl_mf>0 __dbCopy((t_fil),mf) ENDIF ENDIF EXIT CASE menu1 > 0 ind=STUFF(ind,menu1,1,; IF(SUBSTR(ind,menu1,1)==CHR(251)," ",CHR(251))) ENDCASE ENDDO DBGOTO(t_rec) RETURN NIL ************ Function s_RECON(t_base) Local fname:={}, t_name, kp, kv Local t_fil:="aa__bb__" Private t_ind kp=FCOUNT() ASIZE(fname,kp) AFIELDS(fname) t_name=SUBSTR(t_base,1,RAT(".",t_base)-1) s_SYS("Минутку терпения","Идет реорганизация файла") __dbCopy((t_fil),fname) t_ind=INDEXKEY(0) USE FERASE(t_base) FRENAME(t_fil+".DBF",t_base) IF FILE(t_name+".DBT") FERASE(t_name+".DBT") IF FILE(t_fil+".DBT") FRENAME(t_fil+".DBT",t_name+".DBT") ENDIF ENDIF USE (t_base) IF .NOT. EMPTY(t_ind) kv=s_ERR("Провести индексирование по",; "старому индексному выражению ?","%[ Да ]","[ Нет ]") IF kv=1 DBCREATEINDEX(t_name,t_ind,{||&t_ind}) ENDIF ENDIF s_SYS() RETURN NIL ********** ********** и еще можно ли сюда добавить функции мышки?



полная версия страницы