Tcl-обертка rapi.tcl для библиотеки rapi.dll (ActiveSync)

Работает с любой версией ActiveSync, не требует компиляции и настройки. Написана несколько лет назад и с тех пор используется в продакшене. За отсутствием хидеров к библиотеке константы были найдены в дизассемблерном листинге на просторах интернет. Комментарии там тоже были - иероглифами, так что, вероятно, надо сказать "спасибо" неизвестным китайским хакерам. Переделывая знаменитые строки: "и на руинах $софта напишут наши имена". Здесь подразумеваются закрытые программные продукты, если кто не понял :-) Но, поскольку я не хакер, получив моральное удовлетворение от лицезрения вышеописанных руин, я продолжил заниматься своим делом, реализовав предлагаемую вашему вниманию библиотечку.

#    Copyright 2009, Mobile Business Group
#    This program is free software: you can redistribute it and/or modify
#    it under the terms of the GNU General Public License as published by
#    the Free Software Foundation, either version 3 of the License, or
#    (at your option) any later version.
#
#    This program is distributed in the hope that it will be useful,
#    but WITHOUT ANY WARRANTY; without even the implied warranty of
#    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
#    GNU General Public License for more details.
#
#    You should have received a copy of the GNU General Public License
#    along with this program.  If not, see http://www.gnu.org/licenses/.

package require Ffidl
package provide rapi 0.1

namespace eval ::rapi {
    variable rapi_rcsid {$Id: rapi.tcl,v 0.1 2007/10/06 12:00:00 mobile_business_group Exp $}
 variable rapi_dll

 namespace export mount umount file

 set rapi_dll [file join $env(SystemRoot) system32 rapi.dll]
 if { ![file exists $rapi_dll] } {
  return -code error "Не установлена библиотека 'rapi.dll' Необходимо установить Microsoft ActiveSync."
 }

 ::ffidl::callout CeRapiInitEx {pointer-byte} uint32 [::ffidl::symbol $rapi_dll CeRapiInitEx]
 ::ffidl::callout CeCreateDirectory {pointer-utf16 uint32} int [::ffidl::symbol $rapi_dll CeCreateDirectory]
 ::ffidl::callout CeRemoveDirectory {pointer-utf16} int [::ffidl::symbol $rapi_dll CeRemoveDirectory]
 ::ffidl::callout CeDeleteFile {pointer-utf16} int [::ffidl::symbol $rapi_dll CeDeleteFile]
 ::ffidl::callout CeRapiUninit {} void [::ffidl::symbol $rapi_dll CeRapiUninit]
 ::ffidl::callout CeGetLastError {} uint32 [::ffidl::symbol $rapi_dll CeGetLastError]
 ::ffidl::callout CeRapiGetError {} uint32 [::ffidl::symbol $rapi_dll CeRapiGetError]
 ::ffidl::callout CeCopyFile {pointer-utf16 pointer-utf16 int} uint32 [::ffidl::symbol $rapi_dll CeCopyFile]
 ::ffidl::callout CeCreateFile {pointer-utf16 uint32 uint32 pointer uint32 uint32 pointer} uint32 [::ffidl::symbol $rapi_dll CeCreateFile]
 ::ffidl::callout CeCloseHandle {uint32} int [::ffidl::symbol $rapi_dll CeCloseHandle]
 ::ffidl::callout CeWriteFile {uint32 pointer-byte uint32 pointer-byte pointer} int [::ffidl::symbol $rapi_dll CeWriteFile]
 ::ffidl::callout CeReadFile {uint32 pointer-byte uint32 pointer-byte pointer} int [::ffidl::symbol $rapi_dll CeReadFile]
 ::ffidl::callout CeFindFirstFile {pointer-utf16 pointer-byte} uint32 [::ffidl::symbol $rapi_dll CeFindFirstFile]
 ::ffidl::callout CeMoveFile {pointer-utf16 pointer-utf16} uint32 [::ffidl::symbol $rapi_dll CeMoveFile]
 ::ffidl::callout CeSHCreateShortcut {pointer-utf16 pointer-utf16} uint32 [::ffidl::symbol $rapi_dll CeSHCreateShortcut]
 ::ffidl::callout CeGetFileSize {uint32 pointer-byte} uint32 [::ffidl::symbol $rapi_dll CeGetFileSize]

 proc sleep {time} {
  after $time set end 1
  vwait end
 }

 proc mount {} {
  set buff [binary format i3 {12 0 0}]
  set res [CeRapiInitEx $buff]
  binary scan $buff i3 a
  if {[lindex $a 2] != 0} {return "Не удалось инициализировать библиотеку 'rapi.dll'."}
  sleep 3000
  return TCL_OK
 }

 proc umount {} {
  CeRapiUninit
 }

 proc file {cmd args} {
  if {$cmd eq {mkdir}} {
   if {[CeCreateDirectory [lindex $args 0] 0] != 0} {return TCL_OK}
   return -code error "Не удалось создать каталог."
  }

  if {$cmd eq {rmdir}} {
   if {[CeRemoveDirectory [lindex $args 0]] != 0} {return TCL_OK}
   return -code error "Не удалось удалить каталог."
  }

  if {$cmd eq {delete}} {
   if {[CeDeleteFile [lindex $args 0]] != 0} {return TCL_OK}
   return -code error "Не удалось удалить файл."
  }

  if {$cmd eq {write}} {
   # ::rapi::file write $path $data
   set a {}
   set c [binary format i 0]
   set h [CeCreateFile [lindex $args 0] "1073741824" 2 0 2 128 0]
   binary scan $h i1 a
   if {$a == -1} {return -code error "Не удалось открыть файл."}
   if {[CeWriteFile $h [lindex $args 1] [string length [lindex $args 1]] $c 0] == 0} {
    CeCloseHandle $h
    return -code error "Не удалось записать данные в файл."
   }
   CeCloseHandle $h
   binary scan $c i1 a
   return $a
  }

  if {$cmd eq {read}} {
   # ::rapi::file read $path
   set a {}
   set filesize [binary format i 0]
   set c [binary format i 0]
   set d [binary format i 0]
   set data {}

   set h [CeCreateFile [lindex $args 0] "2147483648" 1 0 3 128 0]
   binary scan $h i1 a
   if {$a == -1} {return -code error "Не удалось открыть файл."}

   set filesize [CeGetFileSize $h $d]
   set buffer [binary format x$filesize]

   set c [binary format i1 0]
   if {[CeReadFile $h $buffer $filesize $c 0] == 0} {
    return -code error "Не удалось целиком прочитать файл."
   }

   CeCloseHandle $h
   return $buffer
  }

  if {$cmd eq {exists}} {
   set buffer [binary format x1024]
   if {[CeFindFirstFile [lindex $args 0] $buffer] != -1} {
    return 1
   } else {
    return 0
   }
  }

  if {$cmd eq {move}} {
   # ::rapi::file move $from $to
   if {[CeMoveFile [lindex $args 0] [lindex $args 1]] != 0} {return TCL_OK}
   return -code error "Не удалось переместить файл."
  }

  if {$cmd eq {link}} {
   # ::rapi::file link $path_shortcut $path_target
   if {[CeSHCreateShortcut [lindex $args 0] [lindex $args 1]] != 0} {return TCL_OK}
   return -code error "Не удалось создать ярлык."
  }
 }
}