Консольное приложение

[Admin]

Привет всем.

Вроде на Кларе можно было писать консольное приложение которое выполняется и пишет результат в консоль.
Нужно тулзу для командной строки написать.

Кто что знает?

Спасибо

[Дед Пахом]

Был давно в клалисте пример, года 2-3 назад, надо там спросить. Помню только, что в exp-файле вместо "GUI" надо написать что-то другое.

[Yufil]

Добрый день !

Надо получить хендлы на потоки StdIn и StdOut

STD_INPUT_HANDLE EQUATE(-10)
STD_OUTPUT_HANDLE EQUATE(-11)
hStdIn LONG
hStdOut LONG
....
GetStdHandle(ULONG),UNSIGNED,PASCAL,NAME('GetStdHandle')
Lwrite(UNSIGNED,ULONG,UNSIGNED),UNSIGNED,PASCAL,RAW,NAME('_lwrite')
Lread(UNSIGNED,ULONG,UNSIGNED),UNSIGNED,PASCAL,RAW,NAME('_lread')
Lclose(Unsigned),Unsigned,PASCAL,Raw,Name('_lclose')
...

hStdIn = GetStdHandle(STD_INPUT_HANDLE)
hStdOut = GetStdHandle(STD_OUTPUT_HANDLE)

А потом читать StdIn и писать в StdOut
Err# = Lread(hStdIn,Address(Buffer),BufferLength)
Err# = Lwrite(hStdOut,Address(Buffer),BufferLength)

Остальное в MSDN

[Admin]

Всем спасибо. Будем думать

[AnDS]

пример был где-то. поискать?

[Admin]

пример был где-то. поискать?

Поищи

[Yufil]

Там есть ещё тонкость - надо переопределить хуки на Message, Halt и т д

System{Prop:HaltHook}=Address(MyHalt)
System{Prop:MessageHook}=Address(MyMessage)
System{Prop:FatalErrorHook}=Address(MyFatalError)

И написать свои функции MyMessage и т.д, чтобы тоже выводили сообщения в выходной поток
А менять GUI в проекте бесполезно...

[Дед Пахом]

http://www.clarionmag.com/col/98-12-har ... arion.html
Статья Пола Аттрайда в кламаге за 2001г.

[Admin]

Пример консольного приложения от AnDS

[WadimZapara]

Моя библиотечка (но - только для XP и выше)

Код: Выделить всё

ConsoleLibrary   PROGRAM
  MAP
    MODULE('Windows.dll')
      GetLastError(),LONG,PASCAL,DLL(TRUE)
      SetLastError(Long),RAW,PASCAL,DLL(TRUE)
      CloseHandle(Long handle), Bool,RAW,PASCAL,DLL(TRUE),Proc
      GetStdHandle(Long nStdHandle),Long,RAW,PASCAL,DLL(TRUE)
      GetFileType(Long hFile),Long,RAW,PASCAL,DLL(TRUE)
      GetConsoleScreenBufferInfo(Long hConsoleOutput, ULong AddresConsoleScreenBufferInfo),BOOL,RAW,PASCAL,DLL(TRUE),Proc
      ReadConsoleOutputCharacter(Long hConsoleOutput, *CString lpCharacter, Long nLength, Long dwReadCoord, |
                    *Long lpNumberOfCharsRead),BOOL,RAW,PASCAL,DLL(TRUE),Name('ReadConsoleOutputCharacterA'),Proc

      WriteConsoleOutputCharacter(Long hConsoleOutput, *CString lpCharacter, Long nLength, Long dwWriteCoord, |
                    *Long lpNumberOfCharsWritten),BOOL,RAW,PASCAL,DLL(TRUE),Name('WriteConsoleOutputCharacterA'),Proc

      WriteFile(Long hFile, *CString lpBuffer, Long nNumberOfBytesToWrite, *Long lpNumberOfBytesWritten, |
                Long lpOverlapped=0),BOOL,RAW,PASCAL,DLL(TRUE),Proc
     
      LoadLibrary(*CString NameLibrary),UnSigned,RAW,Pascal,DLL(TRUE),Name('LoadLibraryA')
      GetProcAddress(UnSigned handle, *CString NameFunction), ULong,Raw,Pascal,DLL(TRUE)
      FreeLibrary(UnSigned handle),Long,RAW,Pascal,DLL(TRUE),Proc
    END
    Module('')
      AttachConsole(Long dwProcessId),BOOL,RAW,PASCAL,DLL(TRUE),Name('AttachConsole')
    End
    Include('Console.inc')
    ! В <Console.inc> прототипы для RunAttachConsole, WriteToConsole, ChangeSlahToCRLF, PrintMsg, CloseWriteToConsole
  END
!------------------------------------------
! плохой файловый Handle
INVALID_HANDLE_VALUE    EQUATE(-1)
!------------------------------------------
! типы файлового Handle
FILE_TYPE_UNKNOWN   Equate(0)
FILE_TYPE_DISK      Equate(1)
FILE_TYPE_CHAR      Equate(2)
FILE_TYPE_PIPE      Equate(3)
FILE_TYPE_REMOTE    Equate(8000h)
!------------------------------------------
! коды стандртных устройств для GetStdHandle()
STD_INPUT_HANDLE    Equate(-10)
STD_OUTPUT_HANDLE   Equate(-11)
STD_ERROR_HANDLE    Equate(-12)
!------------------------------------------
! идентификаторы доступа к файлу
GENERIC_READ              EQUATE(80000000h)
GENERIC_WRITE             EQUATE(40000000h)
GENERIC_EXECUTE           EQUATE(20000000h)
GENERIC_ALL               EQUATE(10000000h)
!------------------------------------------
! идентификаторы разрешаемого совместного доступа к файлу
FILE_SHARE_READ         Equate(1)
FILE_SHARE_WRITE        Equate(2)
!------------------------------------------
! атрибуты файла
FILE_ATTRIBUTE_READONLY   EQUATE(00000001h)
FILE_ATTRIBUTE_HIDDEN     EQUATE(00000002h)
FILE_ATTRIBUTE_SYSTEM     EQUATE(00000004h)
FILE_ATTRIBUTE_DIRECTORY  EQUATE(00000010h)
FILE_ATTRIBUTE_ARCHIVE    EQUATE(00000020h)
FILE_ATTRIBUTE_NORMAL     EQUATE(00000080h)
FILE_ATTRIBUTE_TEMPORARY  EQUATE(00000100h)
!------------------------------------------
! идентификатор 
ATTACH_PARENT_PROCESS   Equate(-1)
!------------------------------------------
! ПЕРЕМЕННЫЕ
AttachConsole        ULONG(0),Static,Name('AttachConsole') ! адрес функции в WinXP из Kernel32.dll
hStdOut              LONG(0),STATIC,THREAD                 ! Handle для STDOUT
TypeStdOut           SIGNED(0),STATIC,THREAD               ! тип устройства STDOUT
Uk                   CString(256),Static                   ! Prompt для CMD.EXE (COMMAND.COM)
      CODE
!======================================================================================================================

!****************************************************************
RunAttachConsole     FUNCTION () !,Signed
! Возвратит  0 - при неудаче (отсутствии консоли)
!           -1 - при удачном подключении к консоли
!          nnn - при перенаправленном выводе консоли
! Используемые типы:
!----------------------------------------------------------------
COORD   Group,Type  ! координата экрана
X           Short
Y           Short
        End
RECT    Group,Type  ! четырёхугольник
Left        Short
Top         Short
Right       Short
Bottom      Short
        End
!----------------------------------------------------------------
err     Long(0)
hlib    Long,Auto
ret     Bool(False)
Cs      CString(1024)

CSBI                    Group  !ConsoleScreenBufferInfo
dwSize      Group(COORD).
dwCursorPos Group(COORD).
Attributes  Short
w4_Rect     Group(RECT).
dwMaxWin    Group(COORD).
                        End
dwWriteCoord Long,Over(CSBI.dwCursorPos)
!****************************************************************
  CODE
  IF ~hStdOut THEN ! ещё не вызывалась
    hStdOut = GetStdHandle(STD_OUTPUT_HANDLE) ! Handle стандартного устройства вывода
    If hStdOut <> INVALID_HANDLE_VALUE Then
      ret = GetFileType(hStdOut)              ! Тип стандартного устройства вывода
      IF ~ret THEN ! тип стандартного устройства вывода НЕ известен, Будем подключаться к консоли
        ! ПЫТАЕМСЯ ПОДКЛЮЧИТЬСЯ К КОНСОЛИ
        Cs = 'KERNEL32.DLL';  hlib = LoadLibrary(Cs)
        If hlib Then   ! библиотека загружена
          Cs = 'AttachConsole';  AttachConsole = GetProcAddress(hlib, Cs)
          if AttachConsole then                           ! получен адрес
            IF AttachConsole(ATTACH_PARENT_PROCESS) THEN   ! если удача - то консоль подключена, вывод должен идти на консоль
              if GetConsoleScreenBufferInfo(hStdOut, Address(CSBI)) then ! считаны параметры консоли?
                WriteToConsole('<13,10>')
                ! СТЕРЕТЬ СТРОКУ ВЫШЕ НА КОНСОЛИ
                Cs = All(' ', CSBI.dwMaxWin.X);  CSBI.dwCursorPos.X = 0
                If WriteConsoleOutputCharacter(hStdOut, Cs, CSBI.dwMaxWin.X, dwWriteCoord, hlib) Then ret = -1. ! удачно, Тип стандартного устройства вывода = КОНСОЛЬ

                ! читаем с консоли
                CSBI.dwCursorPos.Y -= 2
                ReadConsoleOutputCharacter(hStdOut, Cs, CSBI.dwMaxWin.X, dwWriteCoord, hlib)
                Uk = '<13,10>'& Cs[1 : InString('>', Cs)]

              end
            END !IF ret
          end !If AttachConsole
          If ~ret Then err = GetLastError().
          FreeLibrary(hlib)
          If err Then SetLastError(err).
        End !If hlib
      END !IF hlib
    End !If hStdOut <> INVALID_HANDLE_VALUE
  END
  Return(ret)
!*** End of RunAttachConsole ************************************


!****************************************************************
WriteToConsole       PROCEDURE (String txt)
! Выводит строку (как есть) на консоль, если она подключена
ln      Long,Auto
Cs      &CString
err      long
!****************************************************************
  CODE
  If hStdOut And hStdOut <> INVALID_HANDLE_VALUE Then
    ln = Len(txt)
    Cs &= New(CString(ln + 1))
    Cs = txt; ConvertANSItoOEM(Cs)
    WriteFile(hStdOut, Cs, ln, ln, 0)
    Dispose(Cs)
  End
!*** End of WriteToConsole **************************************


!****************************************************************
CloseWriteToConsole Procedure
! завершает вывод в стандартное устройство вывода
!****************************************************************
  Code
  If hStdOut And TypeStdOut < 0 Then            ! консоль, восстановить подсказку
    WriteToConsole(Uk)
    CloseHandle(hStdOut)
    Clear(hStdOut)
  End
!*** End of CloseWriteToConsole *********************************


!****************************************************************
PrintMsg Procedure(String msg, <String Title>, <? ico>)
! выводит сообщение:
! - либо в окно MESSAGE(msg, Title, ico)
!         при этом, если Title пропущен - принимается "Результат"
!                   если ico   пропущен - принимается ICON:Asterisk
! - либо в стандартное устройство вывода
!         при этом Title (если есть) - первая строка
!                  ico - игнорируется
Cs &CString
l  Long,Auto
n  Long(0)
!****************************************************************
    CODE
  If ~hStdOut Then TypeStdOut = RunAttachConsole().
  If TypeStdOut Then
    Cs &= ChangeSlahToCRLF(msg)
    If Omitted(2) Then WriteToConsole(Cs &'<13,10>')
    Else               WriteToConsole(Title &'<13,10>'& Cs &'<13,10>')
    End
  Else
    If Omitted(2) Then
      Cs &= New(CString(10)); Cs = 'Результат'
    Else
      Cs &= New(CString(Len(Title)+1));  Cs = Title
    End
    If Omitted(3) Then  Message(msg, Cs, ICON:Asterisk)
    Else                Message(msg, Cs, ico)
    End
  End
  Dispose(Cs)
!*** End of PrintMsg ********************************************


!****************************************************************
ChangeSlahToCRLF  Procedure(String str) !,*CString 
! из исходной строки с символами '|' формирует строку с '<13,10>'
! Применение:
! newstr &= ChangeSlahToCRLF(str)
! ...
! Dispose(newstr)
cstr    &CString
ln      Long,Auto
n       Long(0)
!****************************************************************
  CODE
  ln = Len(str)+1
  Loop
    n = InString('|', str, 1, n+1)
    If ~n Then Break.
    ln += 1
  End
  cstr &= New(CString(ln));  cstr = str
  Loop
    n = InString('|', cstr)
    If ~n Then Break.
    If n = 1 Then
      cstr = '<13,10>'& cstr[2 : Len(cstr)]
    ElsIf n = Len(cstr) Then
      cstr = cstr[1 : n-1] &'<13,10>'
    Else
      cstr = cstr[1 : n-1] &'<13,10>'& cstr[n+1 : Len(cstr)]
    End
  End
 RETURN cstr
!*** End of ChangeSlahToCRLF ************************************