Ресурсы Unigraphics: Создание постпроцессоров. Использование PostBuilder. Исходный код Postino ( PB )

Псевдокод Postino.

 Декодирование рабочего кода постбилдера Postino мы также осуществляли методом "обратного инжиринга". Я долго думал какую версию Вам показать. На основе 16-ой выходило слишком просто. На основе UG v>6, 7.5, 8 ...  - выходило слишком мудрено и запутанно. Поэтому была выбрана версия по серединке NX4 - PB33. Основная цель была показать как все работает.

Псевдокод PostBuilder 33 (NX4)

Псевдоисходники: Postino33.zip

 

Вы знаете, смотря исходный код Postino - я часто в нем находил код, который не работал в этой версии PostBuilder-а. Но в последующих версиях, эта возможность уже включалась на полную катушку.

 Например, запуск Постбилдера 7.5 теперь производиться довольно оригинально. Для начала post_builder.exe обращается к лицензионному серверу, если все нормально, то post_builder.exe создает при каждом новом запуске в папке пользователя кодированный файл pb_license_tcl.txt. Многократные запуски и сравнение его содержимого - показало, что они различаются только показанным на рисунке тексте, в котором вероятно всего, закодирована числовая дата. Далее, post_builder.exe запускает с параметрами Postino.exe. Postino.exe - проверяет существование pb_license_tcl.txt файла и его ликвидность, а после запускается в нормальном режиме.

Для контраста, ниже, мы показываем псевдокод 2-х функций Postino v7.5.0.1: main()  и  PostBuilder_AppInit().

  Функция main():

//----- (00403440) --------------------------------------------------------
int main(int argc, char* argv[])
{
char ST10_1_0; // ST10_1@0
int v6; // eax@24
int s; // [sp+138h] [bp+0h]@1
unsigned int v8; // [sp+114h] [bp-24h]@1
char *v9; // [sp+4h] [bp-134h]@1
char *v10; // [sp+118h] [bp-20h]@1
char *v11; // [sp+124h] [bp-14h]@1
signed int v12; // [sp+134h] [bp-4h]@1
int v13; // [sp+120h] [bp-18h]@1
char Filename[260]; // [sp+8h] [bp-130h]@1
char *v15; // [sp+128h] [bp-10h]@1
int v16; // [sp+12Ch] [bp-Ch]@13

v8 = (unsigned int)& s ^ dword_4196D0;
v9 = "1456928370";
v10 = "!$%^(@*#&)";
v11 = "2006061812";

Tcl_SetPanicProc(sub_4033E0);
sub_40596E(a3, a4, 0, "C");
sub_4036D0(argc, argv, (int)&v12, argv);
GetModuleFileNameA(0, &Filename, 260);
argv = &Filename;
v15 = &Filename[0];
while ( *v15 )
{
  if ( *v15 == 92 ) *v15 = 47; // замена \ на /
  ++v15;
}

 if ( sub_404837(argv[1], v11, 10) )
 {
  if ( sub_404837(argv[1], v9, 10) && sub_404837(argv[1], v10, 10) )
  {
    sub_4040A8(a1, a2, a3, "\nUG PostBuilder No License Usage\n", ST10_1_0);
    v16 = 3;
  } else {
    if ( !sub_403CC0(argv[2], "UG_POST_MILL") )
    {
       dword_41C404 = 533;
       sub_4040A8(a1, a2, a3, "\nUG PostBuilder General License Usage\n", ST10_1_0);
    }
    if ( !sub_403CC0(argv[2], "UG_POST_ADV_BLD") )
    {
       dword_41C404 = 534;
       sub_4040A8(a1, a2, a3, "\nUG PostBuilder Advanced License Usage\n", ST10_1_0);
    }
    v16 = 3;
  }
 } else {
  if ( !sub_403CC0(argv[2], "UG_POST_MILL") )
  {
    dword_41C404 = 533;
    sub_4040A8(a1, a2, a3, "\nUG PostBuilder General License Usage\n", ST10_1_0);
  }
  if ( !sub_403CC0(argv[2], "UG_POST_ADV_BLD") )
  {
    dword_41C404 = 535;
    sub_4040A8(a1, a2, a3, "\nUG PostBuilder Author License Usage\n", ST10_1_0);
  }
  byte_41BE28 = 0;
  sub_403FC0(&byte_41BE28, argv[3]);
  byte_41AA28 = 0;
  if ( argv[4] ) sub_403FC0(&byte_41AA28, argv[4]);
  v16 = 5;
 }
 if ( argc > v16 ) sub_403FB0(&unk_41A448);
 argc = 1;
 sub_403FB0(v13);
 dword_416000 = 0;
 v6 = Tcl_CreateInterp();
 Tk_MainEx(argc, argv, sub_401000, v6);

 return 0;
}

  Функция PostBuilder_AppInit():

//----- (00401000) --------------------------------------------------------
// int sub_401000 (int a1<ebx>, int a2<ebp>, int a3<edi>, int a4<esi>, int a5)
int sub_401000(Tcl_Interp *interp)
{
char ST18_1_0; // ST18_1@0
signed int result; // eax@2
char v7; // ST18_1@12
char v8; // al@10
int v9; // eax@10
void **v10; // eax@23
void **v11; // eax@28
void **v12; // eax@33
int s; // [sp+BD0h] [bp+0h]@1
unsigned int v14; // [sp+BC8h] [bp-8h]@1
int v15; // [sp+BCCh] [bp-4h]@1
int v16; // [sp+4h] [bp-BCCh]@1
char v17; // [sp+5E8h] [bp-5E8h]@10

v14 = (unsigned int)& s ^ dword_4196D0;
v15 = 0;
v16 = 0;

 if ( Tcl_Init(interp) == 1 )
 {
     sub_4040A8(a1, a2, a3, "\nTcl initialization failed...", ST18_1_0);
     result = 1;
 } else {
   if ( Tk_Init(interp) == 1 )
   {
     sub_4040A8(a1, a2, a3, "\nTk initialization failed...", ST18_1_0);
     result = 1;
   } else {
     if ( Tix_Init(interp) == 1 )
     {
        sub_4040A8(a1, a2, a3, "\nTix initialization failed...", ST18_1_0);
        result = 1;
     } else {
       if ( dword_416000 && Tk_CreateConsoleWindow(a5) == 1 )
       {
         result = 1;
       } else {
         Tcl_GlobalEval(interp, "global env");
         Tcl_GlobalEval(interp, "set env(PB_DIR) $env(PB_HOME)/app");
         Tcl_GlobalEval(interp, "set env(PWD) [pwd]");
         v8 = Tcl_GetVar(interp, "env(PWD)", 0);
         sub_4040A8(a1, a2, a3, (int)"\n** Starting UG/Post Builder in %s **\n", v8);
         Tcl_GlobalEval(interp, "source $env(PB_HOME)/tcl/exe/stooop.tcl");
         Tcl_GlobalEval(interp, "namespace import stooop::*");
         Tcl_GlobalEval(interp, "source $env(PB_DIR)/ui/ui_pb_resource.tcl");
         Tcl_GetVar(interp, "env(HOME)", 0);
         sub_403FB0(&v17);
         sub_403FC0(&v17, "/ui_pb_user_resource.tcl");
         v9 = sub_403F92(a2, a4, &v17, "r");
         v16 = v9;
         if ( v9 )
         {
            Tcl_GlobalEval(interp, "source $env(HOME)/ui_pb_user_resource.tcl");
            sub_403E52(a1, a2, v16);
         }
         v7 = dword_41C404;
         switch ( dword_41C404 )
         {
           case 0x215: Tcl_SetVar(interp, "gPB(PB_LICENSE)", "UG_POST_MILL", 0); break;
           case 0x216: Tcl_SetVar(interp, "gPB(PB_LICENSE)", "UG_POST_ADV_BLD", 0); break;
           case 0x217: Tcl_SetVar(interp, "gPB(PB_LICENSE)", "UG_POST_AUTHOR", 0); break;
              default: Tcl_SetVar(interp, "gPB(PB_LICENSE)", "UG_POST_NO_LICENSE", 0); break;
         }
         if ( sub_403D50(&byte_41BE28) )
         {
           Tcl_SetVar(interp, "gPB(PB_SITE_ID)", &byte_41BE28, 0);
           Tcl_SetVar(interp, "gPB(lic_list)", &byte_41AA28, 0);
         }
         Tcl_CreateObjCommand(interp, "UI_PB_encrypt_post", sub_401700, 0, 0); 
         Tcl_CreateObjCommand(interp, "UI_PB_decrypt_post", sub_402030, 0, 0);
         sub_403090(interp, &off_418250);
         Tcl_GlobalEval(interp, "UIPB__createGauge");
         Tcl_GlobalEval(interp, "global prog_pct prog_pct1 prog_inc");
         Tcl_GlobalEval(interp, "set prog_pct 0");
         Tcl_GlobalEval(interp, "set prog_inc [expr 100/40]");
         v15 = 0;
         while ( sub_403CC0(*(&off_41896C + v15), "SRC_EOL") )
         {
          sub_4040A8(a1, a2, a3, "%s", ".");
          v10 = sub_403B08();
          sub_403AAC(a1, a2, a3, v10[2]);
          Tcl_GlobalEval(interp, "set prog_pct1 [expr $prog_pct + $prog_inc]");
          Tcl_GlobalEval(interp, "UIPB__updateGauge $prog_pct $prog_pct1");
          Tcl_GlobalEval(interp, "set prog_pct $prog_pct1");
          Tcl_GetVar(interp, "env(PB_DIR)", 0);
          sub_403FB0(&v17);
          sub_403FC0(&v17, *(&off_41896C + v15));
          sub_402D50(a1, a2, a3, a4, a5, &v17);
          Tcl_EvalObjEx(interp, dword_41A444, 131072);
          ++v15;
         }
         sub_403140(interp, &off_417848);
         Tcl_GlobalEval(interp, "wm withdraw .");
         Tcl_GlobalEval(interp, "UI_PB_main .widget");
         Tcl_GlobalEval(interp, "bind .widget <Destroy> UI_PB_ExitPost");
         Tcl_GlobalEval(interp, "$gPB(top_window) config -cursor watch");
         v15 = 0;
         while ( sub_403CC0(*(&off_418D40 + v15), "SRC_EOL") )
         {
          sub_4040A8(a1, a2, a3, "%s", ".");
          v11 = sub_403B08();
          sub_403AAC(a1, a2, a3, v11[2]);
          Tcl_GlobalEval(interp, "set prog_pct1 [expr $prog_pct + $prog_inc]");
          Tcl_GlobalEval(interp, "UIPB__updateGauge $prog_pct $prog_pct1");
          Tcl_GlobalEval(interp, "set prog_pct $prog_pct1");
          Tcl_GetVar(interp, "env(PB_DIR)", 0);
          sub_403FB0(&v17);
          sub_403FC0(&v17, (&off_418D40 + v15));
          sub_402D50(a1, a2, a3, a4, a5, &v17);
          Tcl_EvalObjEx(interp, dword_41A444, 131072);
          ++v15;
         }
         Tcl_GlobalEval(interp, "UIPB__updateGauge $prog_pct 100");
         Tcl_GlobalEval(interp, "after 500");
         Tcl_GlobalEval(interp, "UIPB__destroyGauge");
         if ( sub_403D50(&unk_41A448) )
         {
           Tcl_SetVar(interp, "gPB(CMD_LINE_PUI)", &unk_41A448, 0);
           Tcl_GlobalEval(interp, "update");
           Tcl_GlobalEval(interp, "UI_PB_OpenCmdLinePost");
         }
         Tcl_GlobalEval(interp, "wm withdraw .widget; wm deiconify .widget");
         Tcl_GlobalEval(interp, "$gPB(top_window) config -cursor \"\"");
         sub_4040A8(a1, a2, a3, "\n", v7);
         v12 = sub_403B08();
         sub_403AAC(a1, a2, a3, v12[2]);
         Tcl_CreateObjCommand(interp, "UI_PB_execute", sub_402C60, 0, 0);
         Tcl_GlobalEval(interp, "UI_PB_interactive");
         result = 0;
       }
     }
   }
 }
 return result;
}

Если перевести данный Си код в Tcl, то получим примерно следующий код:

для версии v16 скрипт postino16.tcl

# set PB_license 0 ; # NO
# set PB_license 495 ; # UG_POST_EXE
# set PB_license 533 ; # UG_POST_MILL
set PB_license 534 ; # UG_POST_ADV_BLD

global env
set env(PB_DIR) $env(PB_HOME)/app
puts "\n** Starting UG Post Builder in [exec pwd] **\n"
source $env(PB_DIR)/ui/ui_pb_main.tcl

proc UI_PB__main_menu {top} {

 global PB_license

 global tixOption;
 global paOption;
 global gPB;
 set ww [frame $top.f -bd 2 -relief raised];
 set gPB(main_menu) $ww;
 set w [frame $ww.mb -bg $paOption(menu_bar_bg)];
 set gPB(main_menu_bar) $w;
 menubutton $w.file -menu $w.file.m -text $gPB(main,file,Label) -underline 0 \
  -takefocus 0 -bg $paOption(menu_bar_bg);
 menubutton $w.option -menu $w.option.m -text $gPB(main,options,Label) -underline 0 \
  -takefocus 0 -bg $paOption(menu_bar_bg);
 menubutton $w.help -menu $w.help.m -text $gPB(main,help,Label) -underline 0 \
  -takefocus 0 -bg $paOption(menu_bar_bg);
 menu $w.file.m;
 $w.file.m add command -label $gPB(main,file,new,Label) -underline 0 \
  -accelerator "Ctrl+N" -command UI_PB_NewPost;
 $w.file.m add command -label $gPB(main,file,open,Label) -underline 0 \
  -accelerator "Ctrl+O" -command UI_PB_OpenPost;

#LICENSE_CK1
 if {$PB_license == 534 } {
  $w.file.m add command -label $gPB(main,file,mdfa,Label) \
   -underline 0 -accelerator "Ctrl+I" -command PB_mdfa_ImportMdfa;
 } else {
  $w.file.m add sep;
 }
 if {$PB_license} {
  $w.file.m add command -label $gPB(main,file,save,Label) \
   -underline 0 -accelerator "Ctrl+S" -command UI_PB_SavePost;
  $w.file.m add command -label $gPB(main,file,save_as,Label) \
   -underline 1 -accelerator "Ctrl+A" -command UI_PB_SavePostAs;
 } else {
  $w.file.m add command -label $gPB(main,file,save,Label) -underline 0 \
   -accelerator "Ctrl+S" \
   -command "tk_messageBox -type ok -icon error" \
   -message $gPB(nav_button,no_license,Message) ;
  $w.file.m add command -label $gPB(main,file,save_as,Label) -underline 1 \
   -accelerator "Ctrl+A" \
   -command "tk_messageBox -type ok -icon error" \
   -message $gPB(nav_button,no_license,Message) ;\
 }

 $w.file.m add command -label $gPB(main,file,close,Label) -underline 0 \
  -accelerator "Ctrl+C" -command UI_PB_ClosePost;
 $w.file.m add sep;
 $w.file.m add command -label $gPB(main,file,exit,Label) -underline 1 \
  -accelerator "Ctrl+X" -command UI_PB_ExitPost;
 global gPB_help_tips;
 # Set balloon state;
 set gPB(use_bal) 1;
 PB_init_balloons -state $gPB(use_bal);
 # Get screen width;
 PB_init_balloons -screen [winfo vrootwidth $top];

#LICENSE_CK2
 if {$PB_license == 534}
 {
   set gPB_help_tips($w.file) {$gPB(main,file,Balloon1)}
   set gPB_help_tips($w.file.m,3) {$gPB(main,file,mdfa,Balloon)};
 } else {
   set gPB_help_tips($w.file) {$gPB(main,file,Balloon)}
 }

 # OPTIONS pull-down menu;
 #;
 menu $w.option.m;
 $w.option.m add command -label $gPB(main,options,properties,Label) -underline 0;
 $w.option.m add checkbutton -under 0 -label $gPB(main,options,advisor,Label);
 # HELP pull-down menu;
 #;
 menu $w.help.m;
 $w.help.m add checkbutton -under 0 -label $gPB(main,help,bal,Label) \
  -variable gPB(use_bal) -onvalue 1 -offvalue 0 \
  -command SetBalloonHelp;
 set gPB(use_info) 0;
 $w.help.m add checkbutton -under 0 -label $gPB(main,help,chelp,Label) \
  -variable gPB(use_info) -onvalue 1 -offvalue 0 \
  -command SetContextHelp;
 $w.help.m add sep;
 $w.help.m add command -label $gPB(main,help,what,Label) -underline 0;
 $w.help.m add command -label $gPB(main,help,dialog,Label) -underline 0;
 $w.help.m add command -label $gPB(main,help,manual,Label) -underline 0;
 $w.help.m add sep;
 $w.help.m add command -label $gPB(main,help,about,Label) -underline 0;
 $w.help.m add command -label $gPB(main,help,acknow,Label) -underline 1;
 pack $w.file -side left;
 pack $w.help -side right;
 pack $w.option -side left;
 pack $w -fill x;
 # FILE tool palette;
 #;
 set t [tixSelect $ww.tool -radio true -allowzero true \
  -padx 2 -pady 2 \
  -selectedbg magenta];
 $t add new -image [tix getimage pb_new] -command UI_PB_NewPost;
 $t add open -image [tix getimage pb_open] -command UI_PB_OpenPost;

#LICENSE_CK3
 if {$PB_license} {
  $t add save -image [tix getimage pb_file] -command UI_PB_SavePost;
 } else {
  $t add save -image [tix getimage pb_file] \
   -command "tk_messageBox -type ok -icon error \
   -message $gPB(nav_button,no_license,Message)";
 }

 [$t subwidget new] config -anchor nw;
 [$t subwidget open] config -anchor nw;
 [$t subwidget save] config -anchor nw;
 pack $t -side left -anchor w -padx 5 -pady 2;
 PB_enable_balloon [$t subwidget new];
 PB_enable_balloon [$t subwidget open];
 PB_enable_balloon [$t subwidget save];
 set gPB_help_tips([$t subwidget new]) {$gPB(tool,new,Label)};
 set gPB_help_tips([$t subwidget open]) {$gPB(tool,open,Label)};
 set gPB_help_tips([$t subwidget save]) {$gPB(tool,save,Label)};
 # HELP tool palette;
 #;
 set h [tixSelect $ww.help -radio false -allowzero true \
  -padx 2 -pady 2 -selectedbg magenta \
  -variable gPB(help_sel_var) \
  -command CB_HelpCmd];
 $h add bal -image [tix getimage pb_balloon];
 $h add inf -image [tix getimage pb_info];
 $h add wtd -image [tix getimage pb_todo];
 $h add dia -image [tix getimage pb_help_dia];
 $h add man -image [tix getimage pb_help_man];
 [$h subwidget inf] config -anchor nw;
 [$h subwidget bal] config -anchor nw;
 [$h subwidget wtd] config -anchor nw;
 [$h subwidget dia] config -anchor nw;
 [$h subwidget man] config -anchor nw;
 # Turn on Balloon Tip by default;
 # (This value can only be set after the button is added.);
 set gPB(help_sel_var) {bal};
 pack $h -side right -anchor w -padx 5;
 PB_enable_balloon [$h subwidget bal];
 PB_enable_balloon [$h subwidget inf];
 PB_enable_balloon [$h subwidget wtd];
 PB_enable_balloon [$h subwidget dia];
 PB_enable_balloon [$h subwidget man];
 set gPB_help_tips([$h subwidget bal]) {$gPB(tool,bal,Label)};
 set gPB_help_tips([$h subwidget inf]) {$gPB(tool,chelp,Label)};
 set gPB_help_tips([$h subwidget wtd]) {$gPB(tool,what,Label)};
 set gPB_help_tips([$h subwidget dia]) {$gPB(tool,dialog,Label.)};
 set gPB_help_tips([$h subwidget man]) {$gPB(tool,manual,Label)};
 # Accelerator bindings;
 #;
 bind all <Control-x> UI_PB_ExitPost;
 bind all <Control-o> UI_PB_OpenPost;
 return $ww;
}


proc UIPB__parse_a_proc { pipe } {
## - Динамическое создание процедуры UIPB__parse_a_proc
## set start_output 0;
## set cmd {};
## set start_output 1;
## for {set i 0} {$i < [llength $pipe]} {incr i} {
## set line [lindex $pipe $i];
## if {$line == \"PROC_EOF\"} {
## set start_output 0;
## }
## if {$start_output} {
## lappend cmd $line;
## }
## }
## eval [join $cmd \\n];
##PROC_EOF
}

wm withdraw .
UI_PB_main .widget
bind .widget <Destroy> UI_PB_ExitPost

Для версии > NX6 ... NX 8.5 скрипт : postino85.tcl

package require Tix

package require stooop


## UI_PB_encrypt_post $env(LIC_HOME)/pb_license_tcl.txt $tmp_list TRUE
proc UI_PB_encrypt_post { filename source_list isLicenseList } {
;
}

## UI_PB_decrypt_post {$tcl_encrypted} TRUE NO NO
proc UI_PB_decrypt_post { filename isReturn isLicenseList isCheck } {
;
}

proc UI_PB__main_menu { top } {
	global tixOption;
	global paOption;
	global gPB;
	set ww [frame $top.f -bd 2 -relief raised];
	set gPB(main_menu) $ww;
	set w [frame $ww.mb -bg $paOption(menu_bar_bg)];
	set gPB(main_menu_bar) $w;
	menubutton $w.file -menu $w.file.m -text $gPB(main,file,Label) -underline 0 \
	  -takefocus 1 -bg $paOption(menu_bar_bg);
	set gPB(file_menu) $w.file.m;
	menubutton $w.help -menu $w.help.m -text $gPB(main,help,Label) -underline 0 \
	  -takefocus 1 -bg $paOption(menu_bar_bg);
	menu $w.file.m -tearoff 0;
	$w.file.m add command -label $gPB(main,file,new,Label) -underline 0 \
	  -accelerator "Ctrl+N" -command UI_PB_NewPost;
	$w.file.m add command -label $gPB(main,file,open,Label) -underline 0 \
	  -accelerator "Ctrl+O" -command UI_PB_OpenPost;
#LICENSE_CK1
	$w.file.m add command -label $gPB(main,file,mdfa,Label) \
	  -underline 0 -accelerator "Ctrl+I" -command PB_mdfa_ImportMdfa;
##$w.file.m add sep;
	$w.file.m add command -label $gPB(main,file,save,Label) \
	  -underline 0 -accelerator "Ctrl+S" -command UI_PB_SavePost;
	$w.file.m add command -label $gPB(main,file,save_as,Label) \
	  -underline 1 -accelerator "Ctrl+A" -command UI_PB_SavePostAs;
##$w.file.m add command -label $gPB(main,file,save,Label) -underline 0 \
##-accelerator "Ctrl+S" \
##-command "tk_messageBox -type ok -icon error \
##-message \$gPB(nav_button,no_license,Message)";
##$w.file.m add command -label $gPB(main,file,save_as,Label) -underline 1 \
##-accelerator "Ctrl+A" \
##-command "tk_messageBox -type ok -icon error \
##-message \$gPB(nav_button,no_license,Message)";

	$w.file.m add command -label $gPB(main,file,close,Label) -underline 0 \
	  -accelerator "Ctrl+C" -command UI_PB_ClosePost;
	$w.file.m add sep;
	$w.file.m add command -label $gPB(main,file,exit,Label) -underline 1 \
	  -accelerator "Ctrl+X" -command UI_PB_ExitPost;
	set gPB(menu_index,file,new) 0;
	set gPB(menu_index,file,open) 1;
	set gPB(menu_index,file,mdfa) 2;
	set gPB(menu_index,file,save) 3;
	set gPB(menu_index,file,save_as) 4;
	set gPB(menu_index,file,close) 5;
	set gPB(menu_index,file,exit) 7;
	set gPB(menu_index,file,sep) 8;
	set gPB(menu_index,file,history) 9;
	global gPB_help_tips;
	# Set balloon state;
	set gPB(use_bal) 1;
	PB_init_balloons -state $gPB(use_bal);
	# Get screen width;
	set gPB(screen_width) [winfo vrootwidth $top];
	PB_init_balloons -screen $gPB(screen_width);
	# HELP pull-down menu;
	#;
	menu $w.help.m -tearoff 0;
	set gPB(help_menu) $w.help.m;
	$w.help.m add checkbutton -under 0 -label $gPB(main,help,bal,Label) \
	  -variable gPB(use_bal) -onvalue 1 -offvalue 0 \
	  -command SetBalloonHelp;
	set gPB(use_info) 0;
	$w.help.m add checkbutton -under 0 -label $gPB(main,help,chelp,Label) \
	  -variable gPB(use_info) -onvalue 1 -offvalue 0 \
	  -command UI_PB_chelp_SetContextHelp;
	$w.help.m add sep;
	$w.help.m add command -label $gPB(main,help,manual,Label) -underline 0 -command HelpCmd_man;
	$w.help.m add sep;
	$w.help.m add command -label $gPB(main,help,about,Label) -underline 0 -command HelpCmd_abo;
	set gPB(menu_index,help,bal) 0;
	set gPB(menu_index,help,chelp) 1;
	set gPB(menu_index,help,manual) 3;
	set gPB(menu_index,help,about) 5;
	set gPB(menu_index,help,acknow) 6;
	pack $w.file -side left;
	pack $w.help -side right;
	pack $w -fill x;
	# FILE tool palette;
	#;
	set t [tixSelect $ww.tool -radio true -allowzero true \
	  -padx 2 -pady 2 \
	  -selectedbg magenta];
	set gPB(file_tool) $t;
	$t add new -image [tix getimage pb_new] -command UI_PB_NewPost;
	$t add open -image [tix getimage pb_open] -command UI_PB_OpenPost;
#LICENSE_CK3
	$t add save -image [tix getimage pb_file] -command UI_PB_SavePost;
##$t add save -image [tix getimage pb_file] \
##-command "tk_messageBox -type ok -icon error \
##-message \$gPB(nav_button,no_license,Message)";

	[$t subwidget new] config -anchor nw;
	[$t subwidget open] config -anchor nw;
	[$t subwidget save] config -anchor nw;
	pack $t -side left -anchor w -padx 5 -pady 2;
	PB_enable_balloon [$t subwidget new];
	PB_enable_balloon [$t subwidget open];
	PB_enable_balloon [$t subwidget save];
	set gPB_help_tips([$t subwidget new]) {$gPB(tool,new,Label)};
	set gPB_help_tips([$t subwidget open]) {$gPB(tool,open,Label)};
	set gPB_help_tips([$t subwidget save]) {$gPB(tool,save,Label)};
#LICENSE_CK2
	set gPB_help_tips($w.file.m,$gPB(menu_index,file,mdfa)) {$gPB(main,file,mdfa,Balloon)};
	# HELP tool palette;
	#;
	set h [tixSelect $ww.help -radio false -allowzero true \
	  -padx 2 -pady 2 -selectedbg magenta \
	  -variable gPB(help_sel_var) \
	  -command CB_HelpCmd];
	set gPB(help_tool) $h;
	$h add bal -image [tix getimage pb_balloon];
	$h add inf -image [tix getimage pb_info];
	$h add dia -image [tix getimage pb_help_dia];
	$h add man -image [tix getimage pb_help_man];
	[$h subwidget bal] config -anchor nw;
	[$h subwidget inf] config -anchor nw;
	[$h subwidget dia] config -anchor nw;
	[$h subwidget man] config -anchor nw;
	pack $h -side right -anchor w -padx 5;
	PB_enable_balloon [$h subwidget bal];
	set gPB_help_tips([$h subwidget bal]) {$gPB(tool,bal,Label)};
	PB_enable_balloon [$h subwidget inf];
	set gPB_help_tips([$h subwidget inf]) {$gPB(tool,chelp,Label)};
	PB_enable_balloon [$h subwidget man];
	set gPB_help_tips([$h subwidget man]) {$gPB(tool,manual,Label)};

	# Turn on Balloon Tip by default;
	# (This value can only be set after the button is added.);
	set gPB(help_sel_var) {bal};
	return $ww;
};

proc UIPB__createGauge {} {
  global gPB;
  # Get screen width;
  set gPB(screen_width) [winfo vrootwidth .];
  set len 300; set w [expr $gPB(screen_width)/2 - $len/2];
  # Create window;
  set pw .prog;
  wm withdraw .;
  toplevel $pw;
  wm title $pw "$gPB(load_pb_title)";
  wm geometry $pw +$w+400;
  wm deiconify $pw;
  set gPB(prog_window) $pw;
  set f [frame $pw.f -class Gauge];
  pack $f -expand yes -fill both -padx 10 -pady 10;
  set hi [option get $f height Height];
  set d [canvas $f.display -borderwidth 0 -bg white -width $len -height $hi];
  pack $d -expand yes;
  set color [option get $f color Color];
  $d create rectangle 0 0 0 $hi -outline "" -fill $color -tags bar;
  $d create text [expr 0.5*$len] 10 -anchor c -text "0%" -tags value;
  grab $gPB(prog_window);
  $gPB(prog_window) config -cursor watch;
};

option add *Gauge.borderWidth 2 widgetDefault;
option add *Gauge.relief sunken widgetDefault;
option add *Gauge.height 25 widgetDefault;
option add *Gauge.color lightBlue widgetDefault;

proc UIPB__updateGauge {val1 val2} {
  global gPB;
  if { $val1 < 0 || $val1 > 100 } {
    error "Bad starting value to Progress Gauge.";
  };
  if { $val2 < 0 || $val2 > 100 } {
    error "Bad ending value to Progress Gauge.";
  };
  set display $gPB(prog_window).f.display;
  set ww [winfo width $display];
  set h [winfo height $display];
  set v [expr $val1 + 1];
  while { $v <= $val2 } {
   set w [expr 0.01*$v*$ww];
   $display coords bar 0 0 $w $h;
   set percent [format "%3.0f%%" $v];
   $display itemconfig value -text $percent;
   update;
   after 50;
   if { $v == $val2 } {
     break
   }
   set v [expr $v + 5];
   if { $v > $val2 } {
     set v $val2
   }
  };
};

proc UIPB__destroyGauge { } {
 global gPB;
 if { [info exists gPB(prog_window)] && [winfo exists $gPB(prog_window)] } {
  global prog_pct prog_pct1 prog_inc;
  unset prog_pct prog_pct1 prog_inc;
  grab release $gPB(prog_window);
  destroy $gPB(prog_window);
  unset gPB(prog_window);
  update;
 };
};

#===========================================================
#LICENSE_KEY UG_POST_ADV_BLD 534 pb_license_tcl.txt
#1456928370 !$%^(@*#&) 2006061812 C UG_POST_MILL
#===========================================================
global env

set env(PB_DIR) $env(PB_HOME)/app
set env(PWD) [pwd]
puts "\n** Starting UG Post Builder in $env(PWD) **\n"
#source $env(PB_HOME)/tcl/exe/stooop.tcl
#namespace import stooop::*
source $env(PB_DIR)/ui/ui_pb_resource.tcl

if { [file exists $env(HOME)/ui_pb_user_resource.tcl ] } {
   source $env(HOME)/ui_pb_user_resource.tcl
}

if { [file exists $env(HOME)/ui_pb_user_fonts.tcl ] } {
   source $env(HOME)/ui_pb_user_fonts.tcl
}

# set gPB(PB_LICENSE) "UG_POST_NO_LICENSE" ; # 0 \nNX/Post Builder No License Usage\n
# set gPB(PB_LICENSE) "UG_POST_EXE" ; # 495 \nNX/Post Builder General License Usage\n
# set gPB(PB_LICENSE) "UG_POST_MILL" ; # 533 \nNX/Post Builder General License Usage\n
set gPB(PB_LICENSE) "UG_POST_ADV_BLD" ; # 534 \nNX/Post Builder Advanced License Usage\n
# set gPB(PB_LICENSE) "UG_POST_AUTHOR" ; # 535 \nNX/Post Builder Author License Usage\n

##"__UGPB_ISV_internal_use" #SITE_ID__UGPB_ISV_internal_use
##"For Internal Siemens PLM Use*"
##"For Internal UGS PLM Use Only"
##"CLIENTDEMO - Siemens PLM*"
set gPB(PB_SITE_ID) "__UGPB_ISV_internal_use"
set gPB(lic_list) ""
set gPB(SITE_ID_IS_OK_FOR_LL) 1
set LicInfo(SITE_ID_IS_OK_FOR_PT) 1


source $env(PB_DIR)/ui/ui_pb_main_tcl.tcl
source $env(PB_DIR)/ui/ui_pb_common_tcl.tcl
source $env(PB_DIR)/ui/ui_pb_file_tcl.tcl
source $env(PB_DIR)/ui/ui_pb_balloon_tcl.tcl
source $env(PB_DIR)/ui/ui_pb_context_help_tcl.tcl
source $env(PB_DIR)/dbase/pb_common_tcl.tcl

global procfid ; # char [110]
set procfid "ID: Che" ;

wm withdraw .
UI_PB_main .widget
bind .widget <Destroy> UI_PB_ExitPost
$gPB(top_window) config -cursor watch

source $env(PB_DIR)/ui/ui_pb_class_tcl.tcl
source $env(PB_DIR)/ui/ui_pb_method_tcl.tcl
source $env(PB_DIR)/dbase/pb_file_tcl.tcl
source $env(PB_DIR)/dbase/pb_class_tcl.tcl
source $env(PB_DIR)/dbase/pb_method_tcl.tcl
source $env(PB_DIR)/dbase/pb_pui_parser_tcl.tcl
source $env(PB_DIR)/dbase/pb_proc_parser_tcl.tcl
source $env(PB_DIR)/dbase/pb_machine_tcl.tcl
source $env(PB_DIR)/dbase/pb_format_tcl.tcl
source $env(PB_DIR)/dbase/pb_address_tcl.tcl
source $env(PB_DIR)/dbase/pb_block_tcl.tcl
source $env(PB_DIR)/dbase/pb_list_tcl.tcl
source $env(PB_DIR)/dbase/pb_event_tcl.tcl
source $env(PB_DIR)/dbase/pb_sequence_tcl.tcl
source $env(PB_DIR)/dbase/pb_ude_tcl.tcl
source $env(PB_DIR)/dbase/pb_output_tcl.tcl
source $env(PB_DIR)/ui/ui_pb_machine_tcl.tcl
source $env(PB_DIR)/ui/ui_pb_definition_tcl.tcl
source $env(PB_DIR)/ui/ui_pb_format_tcl.tcl
source $env(PB_DIR)/ui/ui_pb_address_tcl.tcl
source $env(PB_DIR)/ui/ui_pb_block_tcl.tcl
source $env(PB_DIR)/ui/ui_pb_others_tcl.tcl
source $env(PB_DIR)/ui/ui_pb_program_tcl.tcl
source $env(PB_DIR)/ui/ui_pb_progtpth_tcl.tcl
source $env(PB_DIR)/ui/ui_pb_gcode_tcl.tcl
source $env(PB_DIR)/ui/ui_pb_mcode_tcl.tcl
source $env(PB_DIR)/ui/ui_pb_addrsum_tcl.tcl
source $env(PB_DIR)/ui/ui_pb_cmdmsg_tcl.tcl
source $env(PB_DIR)/ui/ui_pb_addrseq_tcl.tcl
source $env(PB_DIR)/ui/ui_pb_sequence_tcl.tcl
source $env(PB_DIR)/ui/ui_pb_toolpath_tcl.tcl
source $env(PB_DIR)/ui/ui_pb_list_tcl.tcl
source $env(PB_DIR)/ui/ui_pb_preview_tcl.tcl
source $env(PB_DIR)/ui/ui_pb_advisor_tcl.tcl
source $env(PB_DIR)/ui/ui_pb_ude_tcl.tcl


if { [info exists gPB(CMD_LINE_PUI)] } {
  set gPB(CMD_LINE_PUI) ""
  update
  UI_PB_OpenCmdLinePost
}

wm withdraw .widget;
wm deiconify .widget
$gPB(top_window) config -cursor ""

#============================================
## ShellExecuteA(0, "open", filename, 0, 0, 1);
proc UI_PB_execute { fn1 } {
#============================================
 if {0==[ file exists $fn1 ]} { return 1 ; }

## htm html chm hlp txt
 set ext [ file extension $fn1 ] ;

 if {[ string compare $ext ".txt"]==0} {
   catch { exec -- "notepad" $fn1 } ;
   return 0 ;
 }
 if {[ string compare $ext ".htm"]==0 || [ string compare $ext ".html"]==0} {
   catch { exec -- "C:\\Program Files\\Internet Explorer\\iexplore" $fn1 } ;
   ##catch { exec -- "iexplore.exe" $fn1 } err;
   return 0 ;
 }
 if {[ string compare $ext ".chm"]==0} {
   catch { exec -- "hh.exe" $fn1 } ;
   return 0 ;
 }

 return 1 ;
}

UI_PB_interactive

#===========================================================

В тексте Postino только одна функция полностью зависит от платформы - Windows\Unix\Lunix\Mac\. Это - UI_PB_execute. Она используется для вызова контекстно-зависимой помощи. Проще говоря, для открытия файлов помощи и справки (*.chm, *.htm, *.pdf) в соответствующих программах просмотра (Chrome\FireFox\Opera, HtmlHelp, Adobe Acrobat, и тд). Её самая простая реализация происходит в виде: 

//
static int UI_PB_execute
(
    void *client_data, /* This is the mom object */
    void *interp, /* Pointer to the TCL interpreter */
    int argc, /* Count of the numnber of arguments */
    char **argv /* Array of arguments where the argv[0] - The TCL extension */
)
{
 int result = 1 ;
 if (argc>1) 
 {
   ShellExecuteA(0, "open", argv[1], 0, 0, 1);
   result = 0;
 }
 else
 {
   Tcl_WrongNumArgs(......., "Usage: UI_PB_execute file");
   result = 1;
 }
 return result;
}


Copyright © 2001—2009 че